options(warn=-1)
setwd("C:/Users/gk249/Dropbox/PSRM/Vowles, Katz and Stevens (2015)- Replication Files")


############################### TABLE 1 #########################################
df<-read.csv("Correlations.csv")

## Measures of competitiveness, 1950-2010

cor.test(df$National.turnout, df$Log.last.polls, "less")

cor.test(df$National.turnout, df$Lagged.Seat.Difference, "less")

cor.test(df$National.turnout, df$Lagged.Mean.constituency, "less")

cor.test(df$National.turnout, df$logrile.benoit, "greater")


# Measures of competitiveness, 1964-2010

cor.test(df$National.turnout[df$Electn>=1964], df$Log.last.polls[df$Electn>=1964], "less")

cor.test(df$National.turnout[df$Electn>=1964], df$Lagged.Seat.Difference[df$Electn>=1964], "less")

cor.test(df$National.turnout[df$Electn>=1964], df$Lagged.Mean.constituency[df$Electn>=1964], "less")

cor.test(df$National.turnout[df$Electn>=1964], df$logrile.benoit[df$Electn>=1964], "greater")

cor.test(df$National.turnout[df$Electn>=1964],df$Perceived.policy.differences[df$Electn>=1964], "greater")


# Other indicators included in Franklin's framework, 1950 - 2010
cor.test(df$National.turnout,abs(df$Majority.status.poll), "less")

cor.test(df$National.turnout,df$Time.since.last.election, "greater")

cor.test(df$National.turnout,df$Electorate, "less")

# Other indicators included in Franklin's framework, 1964 - 2010 
cor.test(df$National.turnout[df$Electn>=1964],abs(df$Majority.status.poll)[df$Electn>=1964], "less")

cor.test(df$National.turnout[df$Electn>=1964],df$Time.since.last.election[df$Electn>=1964], "greater")

cor.test(df$National.turnout[df$Electn>=1964],df$Electorate[df$Electn>=1964], "less")


############################### FIGURE 1 #####################################
library(ggplot2)

df.2<-rbind(cbind(df$Electn, df$Lagged.Seat.Difference),
	cbind(df$Electn, df$Lagged.Mean.constituency))
df.2<-cbind(df.2,
c(rep("Lagged Seat Margin", length(df$Electn)),
rep("Mean Lagged Constituency Vote Margin", length(df$Electn)))
)
df.2<-data.frame(df.2)
names(df.2)<-c("Election", "Value", "Margin")
df.2$Election<-as.numeric(levels(df.2$Election))[df.2$Election]
df.2$Value<-as.numeric(levels(df.2$Value))[df.2$Value]
df.2$Margin<-factor(df.2$Margin,levels=c( "Lagged Seat Margin",
	"Mean Lagged Constituency Vote Margin"))


p<-ggplot(df.2, aes(x = Election, y = Value)) + 
            geom_point() + 
		stat_smooth(method="lm", colour="gray20", size=1.5, se=FALSE) +
            facet_wrap( ~ Margin, scales="free") + 
            geom_smooth(colour="gray40", size=1.5, linetype="dashed", level=0.9) + 
		scale_x_continuous(breaks=c(1950, 1970, 1992, 2010))
p<-p+theme_bw()
p+ylab("%")

##### Correlations betweeen time and competitiveness measures
cor.test((df$Electn-1949), df$Lagged.Seat.Difference, "greater")
cor.test((df$Electn-1949), df$Lagged.Mean.constituency, "greater")
cor.test((df$Electn[df$Electn>=1964]-1963), df$Lagged.Seat.Difference[df$Electn>=1964], "greater")
cor.test((df$Electn[df$Electn>=1964]-1963), df$Lagged.Mean.constituency[df$Electn>=1964], "greater")

rm(list=ls())

################################# TABLE 2 ####################################
######## First we use MCMC estimation 
####### Then we use likelihood-based estimation for robustness

library(mvtnorm)
library(lme4)	
library(coda)
library(spam)

#TABLE 2 - Column 1 (MCMC)
for (imp in 1:5) {

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise",
		"vote", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))   ## R64 for these matrices
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise
)

y<-df$vote


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Manifesto Benoit", "New.cohort*Manifesto",
			"Young Initiation", "Fem. Franchising"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # Use if only R 32-bit is available
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64-bit
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# Use if only R 32-bit is available
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64-bit
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.Table2.Col1.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.Table2.Col1.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.Table2.Col1.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.Table2.Col1.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.Table2.Col1.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.Table2.Col1.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.Table2.Col1")
rm(list=ls())

DIC<-c()
for (imp in 1:5) {

load(paste("Results.Table2.Col1.MCMC.Imputed", imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise",
		"vote", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise
)

y<-df$vote


D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)

D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)



DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

rm(list=ls())

####
#TABLE 2 - Column 2 (MCMC)
for (imp in 1:5) {

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"vote", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past
)

y<-df$vote


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Manifesto Benoit", "New.cohort*Manifesto",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32-bit
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64-bit
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32-bit
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64-bit
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.Table2.Col2.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.Table2.Col2.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.Table2.Col2.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.Table2.Col2.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.Table2.Col2.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.Table2.Col2.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.Table2.Col2")
rm(list=ls())

DIC<-c()
for (imp in 1:5) {

load(paste("Results.Table2.Col2.MCMC.Imputed",imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"vote", "electn", "constit"))
df<-na.omit(df)



Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past
)

y<-df$vote



D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)

D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)



DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

rm(list=ls())

####
#TABLE 2 - Column 3 (MCMC)
for (imp in 1:5) {

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"vote", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past
)

y<-df$vote


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party Dif", "New.cohort*Party Dif",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.Table2.Col3.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.Table2.Col3.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.Table2.Col3.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.Table2.Col3.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.Table2.Col3.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.Table2.Col3.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.Table2.Col3")
rm(list=ls())


DIC<-c()
for (imp in 1:5) {

load(paste("Results.Table2.Col3.MCMC.Imputed",imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"vote", "electn", "constit"))
df<-na.omit(df)



Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past
)

y<-df$vote


D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)

D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)

DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)


rm(list=ls())

##
#TABLE 2 - Column 4 (MCMC)
for (imp in 1:5) {

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise",
		"valid", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise
)

y<-df$valid


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Manifesto Benoit", "New.cohort*Manifesto",
			"Young Initiation", "Fem. Franchising"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.Table2.Col4.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.Table2.Col4.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.Table2.Col4.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.Table2.Col4.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.Table2.Col4.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.Table2.Col4.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.Table2.Col4")
rm(list=ls())

DIC<-c()
for (imp in 1:5) {

load(paste("Results.Table2.Col4.MCMC.Imputed",imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise",
		"valid", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))



X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise
)

y<-df$valid



D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)

D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)

DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

rm(list=ls())

####
#TABLE 2 - Column 5 (MCMC)
for (imp in 1:5) {

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"valid", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past
)

y<-df$valid


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Manifesto Benoit", "New.cohort*Manifesto",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.Table2.Col5.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.Table2.Col5.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.Table2.Col5.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.Table2.Col5.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.Table2.Col5.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.Table2.Col5.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.Table2.Col5")

rm(list=ls())

DIC<-c()
for (imp in 1:5) {

load(paste("Results.Table2.Col5.MCMC.Imputed",imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"valid", "electn", "constit"))
df<-na.omit(df)



Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))



X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past
)

y<-df$valid



D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)

D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)

DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

rm(list=ls())

####
#TABLE 2 - Column 6 (MCMC)
for (imp in 1:5) {

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"valid", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past
)

y<-df$valid


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party Dif", "New.cohort*Party Dif",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.Table2.Col6.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.Table2.Col6.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.Table2.Col6.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.Table2.Col6.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.Table2.Col6.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.Table2.Col6.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.Table2.Col6")

rm(list=ls())

DIC<-c()
for (imp in 1:5) {

load(paste("Results.Table2.Col6.MCMC.Imputed",imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"valid", "electn", "constit"))
df<-na.omit(df)



Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past
)

y<-df$valid


D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)

D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)

DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

############## Now repeat estimation using likelihood-based methods ##########
library(arm)
#TABLE 2 - Column 1 (Likelihood-based)
Result<-list()

for (j in 1:5) {
load(paste("df.imputed",j))

result<-glmer(vote~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			logrile+I(new.cohort*logrile)+
			young.initiation+fem.franchise+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 

Result[[j]]<-result

print(j)
}

## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5

Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.Table2.Col1.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.Table2.Col1.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.Table2.Col1.ML 

write.csv(Results.Table2.Col1.ML, file="Results.Table2.Col1.ML.csv")
rm(list=ls())


#TABLE 2 - Column 2 (Likelihood-based)
Result<-list()

for (j in 1:5) {
load(paste("df.imputed",j))

result<-glmer(vote~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			logrile+I(new.cohort*logrile)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+rreligion+church.attendance+
			unionm+voted.past+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 
 

Result[[j]]<-result

print(j)
}

## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5

Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.Table2.Col2.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.Table2.Col2.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.Table2.Col2.ML 

write.csv(Results.Table2.Col2.ML, file="Results.Table2.Col2.ML.csv")
rm(list=ls())


## TABLE 2 - Column 3 (Likelihood-based)
Result<-list()

for (j in 1:5) {
load(paste("df.imputed",j))

result<-glmer(vote~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+rreligion+church.attendance+
			unionm+voted.past+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 


Result[[j]]<-result

print(j)
}

save(Result, file="Table2.Column3")

## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5


Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.Table2.Col3.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.Table2.Col3.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.Table2.Col3.ML 

write.csv(Results.Table2.Col3.ML, file="Results.Table2.Col3.ML.csv")
rm(list=ls())


#TABLE 2 - Column 4 (Likelihood-based)

Result<-list()

for (j in 1:5) {
load(paste("df.imputed",j))

result<-glmer(valid~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			logrile+I(new.cohort*logrile)+
			young.initiation+fem.franchise+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 

Result[[j]]<-result

print(j)
}

## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5


Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.Table2.Col4.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.Table2.Col4.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.Table2.Col4.ML 

write.csv(Results.Table2.Col4.ML, file="Results.Table2.Col4.ML.csv")
rm(list=ls())


#TABLE 2 - Column 5 (Likelihood-based)

Result<-list()

for (j in 1:5) {
load(paste("df.imputed",j))

result<-glmer(valid~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			logrile+I(new.cohort*logrile)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+rreligion+church.attendance+
			unionm+voted.past+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 


Result[[j]]<-result

print(j)
}
 
## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5

Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.Table2.Col5.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.Table2.Col5.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.Table2.Col5.ML 

write.csv(Results.Table2.Col5.ML, file="Results.Table2.Col5.ML.csv")
rm(list=ls())


## TABLE 2 - Column 6 (Likelihood-based)
Result<-list()

for (j in 1:5) {
load(paste("df.imputed",j))

result<-glmer(valid~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+rreligion+church.attendance+
			unionm+voted.past+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 


Result[[j]]<-result

print(j)
}

save(Result, file="Table2.Column6")


## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5

Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.Table2.Col6.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.Table2.Col6.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.Table2.Col6.ML 

write.csv(Results.Table2.Col6.ML, file="Results.Table2.Col6.ML.csv")
rm(list=ls())


############################### FIGURE 2 #####################################
### Need to compute average predictive comparisons first before
### plotting

## MARGINAL EFFECTS FOR FIGURE 2 - REPORTED VOTE
Lag.seatmag.established<-c()
Lag.seatmag.new<-c()
Lag.constit.established<-c()
Lag.constit.new<-c()
Last.polls.new<-c()
Last.polls.established<-c()
Partydf.established<-c()
Partydf.new<-c()

for (imp in 1:5) {

load(paste("Results.Table2.Col3.MCMC.Imputed",imp))

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", "excls",
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"vote", "electn", "constit"))
df<-na.omit(df)


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past
)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))



### 1) MARGINAL EFFECT FOR LAG SEATMAG 

# 1.1 Established cohorts
X.original<-X
X.original[,4]<-0
X.original[,6]<-0
X.original[,8]<-0
X.original[,10]<-0

X.prime<-X.original
X.prime[,3]<-df$lag_seatmg+sd(unique(df$lag_seatmg))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Lag.seatmag.established<-c(Lag.seatmag.established, prime-original)

# 1.2 New cohorts
X.original<-X
X.original[,2]<-1
X.original[,4]<-df$lag_seatmg
X.original[,6]<-df$last_polls
X.original[,8]<-df$lag_constit
X.original[,10]<-df$partydf

X.prime<-X.original
X.prime[,3]<-df$lag_seatmg+sd(unique(df$lag_seatmg))
X.prime[,4]<-df$lag_seatmg+sd(unique(df$lag_seatmg))


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Lag.seatmag.new<-c(Lag.seatmag.new, prime-original)

## 2) MARGINAL EFFECT FOR LAST POLLS

# 2.1 Established cohorts
X.original<-X
X.original[,4]<-0
X.original[,6]<-0
X.original[,8]<-0
X.original[,10]<-0

X.prime<-X.original
X.prime[,5]<-log(df$excls+sd(unique(df$excls)))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Last.polls.established<-c(Last.polls.established,prime-original)

# 2.2 New cohorts
X.original<-X
X.original[,2]<-1
X.original[,4]<-df$lag_seatmg
X.original[,6]<-df$last_polls
X.original[,8]<-df$lag_constit
X.original[,10]<-df$partydf

X.prime<-X.original
X.prime[,5]<-log(df$excls+sd(unique(df$excls)))
X.prime[,6]<-log(df$excls+sd(unique(df$excls)))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Last.polls.new<-c(Last.polls.new,prime-original)

## 3) MARGINAL EFFECT FOR LAG CONSTIT

# 3.1 Established cohorts
X.original<-X
X.original[,4]<-0
X.original[,6]<-0
X.original[,8]<-0
X.original[,10]<-0

X.prime<-X.original
X.prime[,7]<-df$lag_constit+sd(unique(df$lag_constit))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Lag.constit.established<-c(Lag.constit.established,prime-original)


# 3.2 New cohorts
X.original<-X
X.original[,2]<-1
X.original[,4]<-df$lag_seatmg
X.original[,6]<-df$last_polls
X.original[,8]<-df$lag_constit
X.original[,10]<-df$partydf

X.prime<-X.original
X.prime[,7]<-df$lag_constit+sd(unique(df$lag_constit))
X.prime[,8]<-df$lag_constit+sd(unique(df$lag_constit))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Lag.constit.new<-c(Lag.constit.new, prime-original)


## 4) MARGINAL EFFECT FOR PERCEIVED PARTY DIFFERENCES

# 4.1 Established cohorts
X.original<-X
X.original[,4]<-0
X.original[,6]<-0
X.original[,8]<-0
X.original[,9]<-min(df$partydf)
X.original[,10]<-0

X.prime<-X.original
X.prime[,9]<-max(df$partydf)

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Partydf.established<-c(Partydf.established, prime-original)

# 4.2 New cohorts
X.original<-X
X.original[,2]<-1
X.original[,4]<-df$lag_seatmg
X.original[,6]<-df$last_polls
X.original[,8]<-df$lag_constit
X.original[,9]<-min(df$partydf)
X.original[,10]<-min(df$partydf)

X.prime<-X.original
X.prime[,9]<-max(df$partydf)
X.prime[,10]<-max(df$partydf)

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)
Partydf.new<-c(Partydf.new, prime-original)

print(imp)
}

Estimates<-cbind(Lag.seatmag.established, Lag.seatmag.new,
		Lag.constit.established, Lag.constit.new,
		Last.polls.established, Last.polls.new,
		Partydf.established,Partydf.new)

Mean.effects<-apply(Estimates,2,mean)*100

CI<-HPDinterval(as.mcmc(Estimates), p=0.9)*100


# Mean and 90% CI
Reported.summary<-cbind(Mean.effects, CI)
Reported.summary<-cbind(c(rep("lag_seatmg",2), rep("lag_constit",2),  rep("last_polls",2), 
	rep("partydf",2)),"Self-reported vote", Reported.summary)
Reported.summary<-cbind(Reported.summary, c("Established cohorts", "New cohorts" ))
colnames(Reported.summary)<-c("Variable", "Vote", "Mean", "lower", "upper", 
			"Sample")


## MARGINAL EFFECTS FOR FIGURE 2 - VALIDATED VOTE
Lag.seatmag.established<-c()
Lag.seatmag.new<-c()
Lag.constit.established<-c()
Lag.constit.new<-c()
Last.polls.new<-c()
Last.polls.established<-c()
Partydf.established<-c()
Partydf.new<-c()

for (imp in 1:5) {

load(paste("Results.Table2.Col6.MCMC.Imputed",imp))

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", "excls",
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"valid", "electn", "constit"))
df<-na.omit(df)

X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past
)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


### 1) MARGINAL EFFECT FOR LAG SEATMAG 

# 1.1 Established cohorts
X.original<-X
X.original[,4]<-0
X.original[,6]<-0
X.original[,8]<-0
X.original[,10]<-0

X.prime<-X.original
X.prime[,3]<-df$lag_seatmg+sd(unique(df$lag_seatmg))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Lag.seatmag.established<-c(Lag.seatmag.established, prime-original)

# 1.2 New cohorts
X.original<-X
X.original[,2]<-1
X.original[,4]<-df$lag_seatmg
X.original[,6]<-df$last_polls
X.original[,8]<-df$lag_constit
X.original[,10]<-df$partydf

X.prime<-X.original
X.prime[,3]<-df$lag_seatmg+sd(unique(df$lag_seatmg))
X.prime[,4]<-df$lag_seatmg+sd(unique(df$lag_seatmg))


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Lag.seatmag.new<-c(Lag.seatmag.new, prime-original)

## 2) MARGINAL EFFECT FOR LAST POLLS

# 2.1 Established cohorts
X.original<-X
X.original[,4]<-0
X.original[,6]<-0
X.original[,8]<-0
X.original[,10]<-0

X.prime<-X.original
X.prime[,5]<-log(df$excls+sd(unique(df$excls)))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Last.polls.established<-c(Last.polls.established,prime-original)

# 2.2 New cohorts
X.original<-X
X.original[,2]<-1
X.original[,4]<-df$lag_seatmg
X.original[,6]<-df$last_polls
X.original[,8]<-df$lag_constit
X.original[,10]<-df$partydf

X.prime<-X.original
X.prime[,5]<-log(df$excls+sd(unique(df$excls)))
X.prime[,6]<-log(df$excls+sd(unique(df$excls)))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Last.polls.new<-c(Last.polls.new,prime-original)

## 3) MARGINAL EFFECT FOR LAG CONSTIT

# 3.1 Established cohorts
X.original<-X
X.original[,4]<-0
X.original[,6]<-0
X.original[,8]<-0
X.original[,10]<-0

X.prime<-X.original
X.prime[,7]<-df$lag_constit+sd(unique(df$lag_constit))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Lag.constit.established<-c(Lag.constit.established,prime-original)


# 3.2 New cohorts
X.original<-X
X.original[,2]<-1
X.original[,4]<-df$lag_seatmg
X.original[,6]<-df$last_polls
X.original[,8]<-df$lag_constit
X.original[,10]<-df$partydf

X.prime<-X.original
X.prime[,7]<-df$lag_constit+sd(unique(df$lag_constit))
X.prime[,8]<-df$lag_constit+sd(unique(df$lag_constit))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Lag.constit.new<-c(Lag.constit.new, prime-original)


## 4) MARGINAL EFFECT FOR PERCEIVED PARTY DIFFERENCES

# 4.1 Established cohorts
X.original<-X
X.original[,4]<-0
X.original[,6]<-0
X.original[,8]<-0
X.original[,9]<-min(df$partydf)
X.original[,10]<-0

X.prime<-X.original
X.prime[,9]<-max(df$partydf)

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Partydf.established<-c(Partydf.established, prime-original)

# 4.2 New cohorts
X.original<-X
X.original[,2]<-1
X.original[,4]<-df$lag_seatmg
X.original[,6]<-df$last_polls
X.original[,8]<-df$lag_constit
X.original[,9]<-min(df$partydf)
X.original[,10]<-min(df$partydf)

X.prime<-X.original
X.prime[,9]<-max(df$partydf)
X.prime[,10]<-max(df$partydf)

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)
Partydf.new<-c(Partydf.new, prime-original)

print(imp)
}

Estimates<-cbind(Lag.seatmag.established, Lag.seatmag.new,
		Lag.constit.established, Lag.constit.new,
		Last.polls.established, Last.polls.new,
		Partydf.established,Partydf.new)

Mean.effects<-apply(Estimates,2,mean)*100

CI<-HPDinterval(as.mcmc(Estimates), p=0.9)*100


# Mean and 90% CI
Validated.summary<-cbind(Mean.effects, CI)
Validated.summary<-cbind(c(rep("lag_seatmg",2), rep("lag_constit",2), rep("last_polls",2), 
	rep("partydf",2)),"Validated vote", Validated.summary)
Validated.summary<-cbind(Validated.summary, c("Established cohorts", "New cohorts" ))
colnames(Validated.summary)<-c("Variable", "Vote", "Mean", "lower", "upper", 
			"Sample")
Marginal.effects.Figure2.MCMC<-rbind(Reported.summary,
							Validated.summary)


# Display resuls
Marginal.effects.Figure2.MCMC

write.csv(Marginal.effects.Figure2.MCMC, "Marginal.effects.Figure2.MCMC.csv")
rm(list=ls())

df<-read.csv("Marginal.effects.Figure2.MCMC.csv")

df$Variable<-factor(df$Variable, 
levels=rev(c( "lag_seatmg", "last_polls", "lag_constit", "partydf")),
labels = rev(c("Lagged Seat Margin", "Last Polls", "Lagged Constituency Vote Margin", "Perceived Party Differences")))


df$Sample<-factor(df$Sample, levels=c("New cohorts", "Established cohorts"))
  

p <- ggplot(df, aes(y= Variable, x=Mean, colour=as.factor(Sample)))+
	geom_point(size=3) + 
	geom_errorbarh(aes(xmax=upper, xmin=lower), height=0.2)+
	 xlab("Marginal effect on turnout (%)")+ylab("")+
	 scale_colour_manual(values=c("black", "gray60"))+
	 facet_grid(~Vote)+scale_x_continuous(breaks=c(-5, 0, 5, 10,15))+
	geom_vline(xintercept = 0, linetype = "longdash", col="gray20")

p+theme_bw()+theme(legend.position = "bottom")+theme(legend.title=element_blank())

rm(list=ls())

################################# TABLE 3 ####################################
######## First we use MCMC estimation 
####### Then we use likelihood-based estimation for robustness


#TABLE 3 - Column 1 (MCMC)
for (imp in 1:5) {
load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", "initial.seat.margin",
		"vote", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, df$initial.seat.margin
)

y<-df$vote


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party DIF", "New.cohort*Party DIF",
			"Young Initiation", "Fem. Franchising",
			"Initial.Seat.Margin"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.Table3.Col1.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.Table3.Col1.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.Table3.Col1.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.Table3.Col1.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.Table3.Col1.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.Table3.Col1.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.Table3.Col1")

rm(list=ls())

DIC<-c()
for (imp in 1:5) {

load(paste("Results.Table3.Col1.MCMC.Imputed",imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", "initial.seat.margin",
		"vote", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, df$initial.seat.margin
)

y<-df$vote


D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)



DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

rm(list=ls())

###
#TABLE 3 - Column 2 (MCMC)
for (imp in 1:5) {

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"vote", "electn", "constit", "initial.seat.margin"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past, df$initial.seat.margin
)

y<-df$vote


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party DIF", "New.cohort*Party DIF",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past", "Initial.Seat.Margin"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.Table3.Col2.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.Table3.Col2.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.Table3.Col2.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.Table3.Col2.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.Table3.Col2.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.Table3.Col2.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.Table3.Col2")

rm(list=ls())

DIC<-c()
for (imp in 1:5) {

load(paste("Results.Table3.Col2.MCMC.Imputed",imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"vote", "electn", "constit", "initial.seat.margin"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past, df$initial.seat.margin
)

y<-df$vote


D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)



DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

rm(list=ls())

###
#TABLE 3 - Column 3 (MCMC)
for (imp in 1:5) {

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", "initial.seat.margin",
		"valid", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, df$initial.seat.margin
)

y<-df$valid


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party DIF", "New.cohort*Party DIF",
			"Young Initiation", "Fem. Franchising",
			"Initial.Seat.Margin"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.Table3.Col3.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.Table3.Col3.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.Table3.Col3.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.Table3.Col3.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.Table3.Col3.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.Table3.Col3.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.Table3.Col3")

rm(list=ls())

DIC<-c()
for (imp in 1:5) {

load(paste("Results.Table3.Col3.MCMC.Imputed",imp))

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", "initial.seat.margin",
		"valid", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))

X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, df$initial.seat.margin
)

y<-df$valid


D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)



D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)


DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

rm(list=ls())

####
#TABLE 3 - Column 4 (MCMC)
for (imp in 1:5) {

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"valid", "electn", "constit", "initial.seat.margin"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past, df$initial.seat.margin
)

y<-df$valid


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party DIF", "New.cohort*Party DIF",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past", "Initial.Seat.Margin"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.Table3.Col4.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.Table3.Col4.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.Table3.Col4.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.Table3.Col4.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.Table3.Col4.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.Table3.Col4.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.Table3.Col4")

rm(list=ls())

DIC<-c()
for (imp in 1:5) {

load(paste("Results.Table3.Col4.MCMC.Imputed",imp))

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"valid", "electn", "constit", "initial.seat.margin"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past, df$initial.seat.margin
)

y<-df$valid

D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election])))
)

D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)


DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

rm(list=ls())

############## Now repeat estimation using likelihood-based methods ##########

# TABLE 3 - Column 1 (Likelihood-based)
Result<-list()

for (j in 1:5) {
load(paste("df.imputed",j))

result<-glmer(vote~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			initial.seat.margin+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 


Result[[j]]<-result

print(j)
}


## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5


Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.Table3.Col1.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.Table3.Col1.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.Table3.Col1.ML

write.csv(Results.Table3.Col1.ML, file="Results.Table3.Col1.ML.csv")
rm(list=ls())


## TABLE 3 - Column 2 (Likelihood-based)
Result<-list()

for (j in 1:5) {
load(paste("df.imputed",j))

result<-glmer(vote~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+rreligion+church.attendance+
			unionm+voted.past+initial.seat.margin+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 


Result[[j]]<-result

print(j)
}

save(Result, file="Table3.Column2")


## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5


Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.Table3.Col2.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.Table3.Col2.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.Table3.Col2.ML

write.csv(Results.Table3.Col2.ML, file="Results.Table3.Col2.ML.csv")
rm(list=ls())


## TABLE 3 - Column 3 (Likelihood-based)
Result<-list()

for (j in 1:5) {
load(paste("df.imputed",j))

result<-glmer(valid~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			initial.seat.margin+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 


Result[[j]]<-result

print(j)
}


## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5


Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.Table3.Col3.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.Table3.Col3.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.Table3.Col3.ML

write.csv(Results.Table3.Col3.ML, file="Results.Table3.Col3.ML.csv")
rm(list=ls())


## TABLE 3 - Column 4 (Likelihood-based)
Result<-list()

for (j in 1:5) {
load(paste("df.imputed",j))

result<-glmer(valid~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+rreligion+church.attendance+
			unionm+voted.past+initial.seat.margin+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 


Result[[j]]<-result

print(j)
}

save(Result, file="Table3.Column4")

## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5


Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.Table3.Col4.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.Table3.Col4.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.Table3.Col4.ML

write.csv(Results.Table3.Col4.ML, file="Results.Table3.Col4.ML.csv")
rm(list=ls())

 
############################### FIGURE 3 #####################################
### Need to compute average predictive comparisons first before
### plotting

## MARGINAL EFFECTS FOR FIGURE 3
Maximal.competition.shortterm<-c()
Minimal.competition.shortterm<-c()
Maximal.competition.longterm<-c()
Minimal.competition.longterm<-c()

for (imp in 1:5) {

load(paste("Results.Table3.Col4.MCMC.Imputed",imp))

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"initial.seat.margin",
		"valid","electn", "constit", "cohort.franklin"))
df<-na.omit(df)



X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past, df$initial.seat.margin
)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))

X.original<-X
X.prime<-X

X.original[,3]<-0
X.prime[,3]<-1
X.original[,4]<-0
X.prime[,4]<- 1*df$new.cohort
X.original[,5]<-log(0.00001)      # no log of 0
X.prime[,5]<-log(1)
X.original[,6]<-log(0.00001)*df$new.cohort  
X.prime[,6]<-log(1)*df$new.cohort     
X.original[,7]<-0
X.prime[,7]<-1
X.original[,8]<-0
X.prime[,8]<- 1*df$new.cohort
X.original[,9]<-0
X.prime[,9]<-1
X.original[,10]<-0
X.prime[,10]<-1*df$new.cohort


Maximal.competition.shortterm<-c(Maximal.competition.shortterm, 
			mean(apply(sapply(1:dim(Results$Beta)[1],
			function(s) pnorm(X.original%*%Results$Beta[s,]+
			Results$B.area[s,Area]+Results$B.election[s,Election]) 
			),2,mean)))
 
Minimal.competition.shortterm<-c(Minimal.competition.shortterm,
			mean(apply(sapply(1:dim(Results$Beta)[1],
			function(s) pnorm(X.prime%*%Results$Beta[s,]+
			Results$B.area[s,Area]+Results$B.election[s,Election]) 
			),2,mean)))


X.original[,24]<-0
X.prime[,24]<-1

Maximal.competition.longterm<-c(Maximal.competition.longterm, 
			mean(apply(sapply(1:dim(Results$Beta)[1],
			function(s) pnorm(X.original%*%Results$Beta[s,]+
			Results$B.area[s,Area]+Results$B.election[s,Election]) 
			),2,mean)))

Minimal.competition.longterm<-c(Minimal.competition.longterm,
			mean(apply(sapply(1:dim(Results$Beta)[1],
			function(s) pnorm(X.prime%*%Results$Beta[s,]+
			Results$B.area[s,Area]+Results$B.election[s,Election]) 
			),2,mean)))


print(imp)
}


Means<-cbind(Minimal.competition.shortterm, Maximal.competition.shortterm,
		Minimal.competition.longterm, Maximal.competition.longterm)


Mean.turnout<-cbind(apply(Means,2,mean), rep(c("Minimal Competition", "Maximal Competition"), 2),
		rep(c("Short-term effects", "Accounting for long-term effects"), each=2))
colnames(Mean.turnout)<-c("Turnout", "Scenario", "Term")

write.csv(Mean.turnout, "Data.Figure3.MCMC.csv")

rm(list=ls())

Competition<-read.csv("Data.Figure3.MCMC.csv")

Competition$Term<-factor(Competition$Term, levels=c("Short-term effects", "Accounting for long-term effects"))
Competition$Scenario<-factor(Competition$Scenario, 
		levels=c("Minimal Competition", "Maximal Competition"))
	
	
p<-ggplot(data=Competition, 
	aes(x=Scenario, y=Turnout)) +
	facet_grid(~Term)+xlab("Scenario")+ylab("Turnout rate")+
	xlab("")+  scale_y_continuous(breaks=c(0, 0.3, 0.6, .9))+  
	geom_bar(colour="black", fill="gray60", width=.7, stat="identity")
p + theme_bw()+ 
	theme(axis.title.y = element_text(vjust = 1.25))+
	theme(legend.position = "bottom")+theme(strip.text=element_text(size=11))+
		theme(legend.title=element_blank())+
theme(axis.text.x  = element_text(size=10))


rm(list=ls())
 
############################### TABLE 4 #########################################
######## First we use MCMC estimation 
####### Then we use likelihood-based estimation for robustness

##
#TABLE 4 - Column 1 (MCMC)
for (imp in 1:5) {

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"pstrong", "duty", "efficacy", "initial.seat.margin",
		"valid", "electn", "constit", "cohort.franklin"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))
Cohort<-as.numeric(factor(df$cohort.franklin), levels=unique(df$cohort.franklin))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		
N.cohort<-length(unique(Cohort))

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1
Matrix.Cohort<-as.spam(matrix(0,n,N.cohort))
for (i in 1:N.cohort) Matrix.Cohort[Cohort==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past, df$initial.seat.margin,
		df$pstrong
)

y<-df$valid


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)
n.cohort<-table(Cohort)

#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 b.cohort<-rep(0,N.cohort)
 precb.election<-1	
 precb.area<-1
precb.cohort<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party Dif", "New.cohort*Party Dif",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past", "Initial.Seat.Margin",
			"PartyID"
		)

 B.election<-matrix(0,lastit,N.election)
  B.area<-matrix(0,lastit,N.area)
  B.cohort<-matrix(0,lastit,N.cohort)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)
  Sigma2.cohort<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]+b.cohort[Cohort]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]-b.cohort[Cohort]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election]-b.cohort[Cohort],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]-b.cohort[Cohort]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area]-b.cohort[Cohort],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area]-b.cohort[Cohort])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

#m.cohort<-tapply(z-X%*%beta-b.area[Area]-b.election[Election],Cohort,sum) # R 32
m.cohort<-as.vector(t(Matrix.Cohort)%*%(z-X%*%beta-b.area[Area]-b.election[Election])) # Requires R 64
b.cohort<-rnorm(N.cohort,(1/(precb.cohort+n.cohort))*m.cohort,sqrt(1/(precb.cohort+n.cohort)))
b.cohort<-b.cohort-mean(b.cohort)
precb.cohort<-rgamma(1,l0+N.cohort/2,d0+crossprod(b.cohort,b.cohort)/2)


   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
Sigma2.cohort[j]<-1/precb.cohort
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
 B.cohort[j,]<-c(b.cohort)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			Sigma2.cohort=Sigma2.cohort, 
			B.area=B.area, B.election=B.election, B.cohort=B.cohort,
			vars=colnames(Beta))
save(Results, file=paste("Results.Table4.Col1.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.Table4.Col1.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.Table4.Col1.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.Table4.Col1.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.Table4.Col1.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.Table4.Col1.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.Table4.Col1")

rm(list=ls())

DIC<-c()
for (imp in 1:5) {

load(paste("Results.Table4.Col1.MCMC.Imputed",imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"pstrong", "duty", "efficacy", "initial.seat.margin",
		"valid", "electn", "constit", "cohort.franklin"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))
Cohort<-as.numeric(factor(df$cohort.franklin), levels=unique(df$cohort.franklin))

X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past, df$initial.seat.margin,
		df$pstrong
)

y<-df$valid

D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area]+Results$B.cohort[s,Cohort], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area]+Results$B.cohort[s,Cohort])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]+
	apply(Results$B.cohort,2,mean)[Cohort], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]+
	apply(Results$B.cohort,2,mean)[Cohort]))
)


DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

rm(list=ls())

###
#TABLE 4 - Column 2 (MCMC)
for (imp in 1:5) {

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"pstrong", "duty", "efficacy", "initial.seat.margin",
		"valid", "electn", "constit", "cohort.franklin"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))
Cohort<-as.numeric(factor(df$cohort.franklin), levels=unique(df$cohort.franklin))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		
N.cohort<-length(unique(Cohort))

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1
Matrix.Cohort<-as.spam(matrix(0,n,N.cohort))
for (i in 1:N.cohort) Matrix.Cohort[Cohort==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past, df$initial.seat.margin,
	 df$duty, df$efficacy
)

y<-df$valid


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)
n.cohort<-table(Cohort)

#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 b.cohort<-rep(0,N.cohort)
 precb.election<-1	
 precb.area<-1
precb.cohort<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party Dif", "New.cohort*Party Dif",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past", "Initial.Seat.Margin",
			"Duty", "Efficacy"
		)

 B.election<-matrix(0,lastit,N.election)
  B.area<-matrix(0,lastit,N.area)
  B.cohort<-matrix(0,lastit,N.cohort)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)
  Sigma2.cohort<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]+b.cohort[Cohort]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]-b.cohort[Cohort]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election]-b.cohort[Cohort],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]-b.cohort[Cohort]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area]-b.cohort[Cohort],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area]-b.cohort[Cohort])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

#m.cohort<-tapply(z-X%*%beta-b.area[Area]-b.election[Election],Cohort,sum) # R 32
m.cohort<-as.vector(t(Matrix.Cohort)%*%(z-X%*%beta-b.area[Area]-b.election[Election])) # Requires R 64
b.cohort<-rnorm(N.cohort,(1/(precb.cohort+n.cohort))*m.cohort,sqrt(1/(precb.cohort+n.cohort)))
b.cohort<-b.cohort-mean(b.cohort)
precb.cohort<-rgamma(1,l0+N.cohort/2,d0+crossprod(b.cohort,b.cohort)/2)


   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
Sigma2.cohort[j]<-1/precb.cohort
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
 B.cohort[j,]<-c(b.cohort)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			Sigma2.cohort=Sigma2.cohort, 
			B.area=B.area, B.election=B.election, B.cohort=B.cohort,
			vars=colnames(Beta))
save(Results, file=paste("Results.Table4.Col2.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.Table4.Col2.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.Table4.Col2.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.Table4.Col2.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.Table4.Col2.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.Table4.Col2.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.Table4.Col2")

rm(list=ls())

DIC<-c()
for (imp in 1:5) {

load(paste("Results.Table4.Col2.MCMC.Imputed",imp))

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"pstrong", "duty", "efficacy", "initial.seat.margin",
		"valid", "electn", "constit", "cohort.franklin"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))
Cohort<-as.numeric(factor(df$cohort.franklin), levels=unique(df$cohort.franklin))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past, df$initial.seat.margin,
	 df$duty, df$efficacy
)

y<-df$valid


D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area]+Results$B.cohort[s,Cohort], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area]+Results$B.cohort[s,Cohort])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]+
	apply(Results$B.cohort,2,mean)[Cohort], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]+
	apply(Results$B.cohort,2,mean)[Cohort]))
)


DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

rm(list=ls())

##
#TABLE 4 - Column 3 (MCMC)
for (imp in 1:5) {

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"pstrong", "duty", "efficacy", "initial.seat.margin",
		"valid", "electn", "constit", "cohort.franklin"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))
Cohort<-as.numeric(factor(df$cohort.franklin), levels=unique(df$cohort.franklin))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		
N.cohort<-length(unique(Cohort))

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1
Matrix.Cohort<-as.spam(matrix(0,n,N.cohort))
for (i in 1:N.cohort) Matrix.Cohort[Cohort==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past, df$initial.seat.margin,
		df$pstrong, df$duty, df$efficacy
)

y<-df$valid


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)
n.cohort<-table(Cohort)

#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 b.cohort<-rep(0,N.cohort)
 precb.election<-1	
 precb.area<-1
precb.cohort<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party Dif", "New.cohort*Party Dif",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past", "Initial.Seat.Margin",
			"PartyID", "Duty", "Efficacy"
		)

 B.election<-matrix(0,lastit,N.election)
  B.area<-matrix(0,lastit,N.area)
  B.cohort<-matrix(0,lastit,N.cohort)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)
  Sigma2.cohort<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]+b.cohort[Cohort]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]-b.cohort[Cohort]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election]-b.cohort[Cohort],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]-b.cohort[Cohort]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area]-b.cohort[Cohort],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area]-b.cohort[Cohort])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

#m.cohort<-tapply(z-X%*%beta-b.area[Area]-b.election[Election],Cohort,sum) # R 32
m.cohort<-as.vector(t(Matrix.Cohort)%*%(z-X%*%beta-b.area[Area]-b.election[Election])) # Requires R 64
b.cohort<-rnorm(N.cohort,(1/(precb.cohort+n.cohort))*m.cohort,sqrt(1/(precb.cohort+n.cohort)))
b.cohort<-b.cohort-mean(b.cohort)
precb.cohort<-rgamma(1,l0+N.cohort/2,d0+crossprod(b.cohort,b.cohort)/2)


   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
Sigma2.cohort[j]<-1/precb.cohort
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
 B.cohort[j,]<-c(b.cohort)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			Sigma2.cohort=Sigma2.cohort, 
			B.area=B.area, B.election=B.election, B.cohort=B.cohort,
			vars=colnames(Beta))
save(Results, file=paste("Results.Table4.Col3.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.Table4.Col3.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.Table4.Col3.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.Table4.Col3.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.Table4.Col3.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.Table4.Col3.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.Table4.Col3")

rm(list=ls())


DIC<-c()
for (imp in 1:5) {

load(paste("Results.Table4.Col3.MCMC.Imputed",imp))

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"pstrong", "duty", "efficacy", "initial.seat.margin",
		"valid", "electn", "constit", "cohort.franklin"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))
Cohort<-as.numeric(factor(df$cohort.franklin), levels=unique(df$cohort.franklin))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past, df$initial.seat.margin,
		df$pstrong, df$duty, df$efficacy
)

y<-df$valid



D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area]+Results$B.cohort[s,Cohort], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area]+Results$B.cohort[s,Cohort])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]+
	apply(Results$B.cohort,2,mean)[Cohort], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]+
	apply(Results$B.cohort,2,mean)[Cohort]))
)


DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

rm(list=ls())

##
###TABLE 4 - Column 4 (MCMC)
for (imp in 1:5) {

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"pstrong", "duty", "efficacy", "initial.seat.margin",
		"valid", "electn", "constit", "cohort.franklin"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))
Cohort<-as.numeric(factor(df$cohort.franklin), levels=unique(df$cohort.franklin))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		
N.cohort<-length(unique(Cohort))

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1
Matrix.Cohort<-as.spam(matrix(0,n,N.cohort))
for (i in 1:N.cohort) Matrix.Cohort[Cohort==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past, df$initial.seat.margin,
		df$pstrong, I(df$pstrong*df$new.cohort),
		df$duty, I(df$duty*df$new.cohort),
		df$efficacy, I(df$efficacy*df$new.cohort)
)

y<-df$valid


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)
n.cohort<-table(Cohort)

#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 b.cohort<-rep(0,N.cohort)
 precb.election<-1	
 precb.area<-1
precb.cohort<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  	# MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party Dif", "New.cohort*Party Dif",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past", "Initial.Seat.Margin",
			"PartyID", "New.cohort*PartyID", 
			"Duty", "New.cohort*Duty", 
			"Efficacy", "New.cohort*Efficacy"
		)

 B.election<-matrix(0,lastit,N.election)
  B.area<-matrix(0,lastit,N.area)
  B.cohort<-matrix(0,lastit,N.cohort)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)
  Sigma2.cohort<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]+b.cohort[Cohort]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]-b.cohort[Cohort]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election]-b.cohort[Cohort],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]-b.cohort[Cohort]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area]-b.cohort[Cohort],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area]-b.cohort[Cohort])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

#m.cohort<-tapply(z-X%*%beta-b.area[Area]-b.election[Election],Cohort,sum) # R 32
m.cohort<-as.vector(t(Matrix.Cohort)%*%(z-X%*%beta-b.area[Area]-b.election[Election])) # Requires R 64
b.cohort<-rnorm(N.cohort,(1/(precb.cohort+n.cohort))*m.cohort,sqrt(1/(precb.cohort+n.cohort)))
b.cohort<-b.cohort-mean(b.cohort)
precb.cohort<-rgamma(1,l0+N.cohort/2,d0+crossprod(b.cohort,b.cohort)/2)


   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
Sigma2.cohort[j]<-1/precb.cohort
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
 B.cohort[j,]<-c(b.cohort)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			Sigma2.cohort=Sigma2.cohort, 
			B.area=B.area, B.election=B.election, B.cohort=B.cohort,
			vars=colnames(Beta))
save(Results, file=paste("Results.Table4.Col4.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.Table4.Col4.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.Table4.Col4.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.Table4.Col4.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.Table4.Col4.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.Table4.Col4.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.90)

save(Beta, file="Fixed-effects MCMC estimates.Table4.Col4")

rm(list=ls())

DIC<-c()
for (imp in 1:5) {

load(paste("Results.Table4.Col4.MCMC.Imputed",imp))

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"pstrong", "duty", "efficacy", "initial.seat.margin",
		"valid", "electn", "constit", "cohort.franklin"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))
Cohort<-as.numeric(factor(df$cohort.franklin), levels=unique(df$cohort.franklin))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past, df$initial.seat.margin,
		df$pstrong, I(df$pstrong*df$new.cohort),
		df$duty, I(df$duty*df$new.cohort),
		df$efficacy, I(df$efficacy*df$new.cohort)
)

y<-df$valid



D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area]+Results$B.cohort[s,Cohort], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area]+Results$B.cohort[s,Cohort])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]+
	apply(Results$B.cohort,2,mean)[Cohort], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]+
	apply(Results$B.cohort,2,mean)[Cohort]))
)


DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

rm(list=ls())

############## Now repeat estimation using likelihood-based methods ##########
# Table 4 - Column 1 (Likelihood-based)
Result<-list()
for (j in 1:5) {
load(paste("df.imputed",j))

result<-glmer(valid~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+rreligion+church.attendance+
			unionm+voted.past+
			initial.seat.margin+
			pstrong+
			(1|constit)+(1|electn)+(1|cohort.franklin),
				data=df, family = binomial("probit")) 

Result[[j]]<-result

print(j)
}


## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5

Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.Table4.Col1.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.Table4.Col1.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.Table4.Col1.ML

write.csv(Results.Table4.Col1.ML, file="Results.Table4.Col1.ML.csv")
rm(list=ls())


##
# Table 4 - Column 2 (Likelihood-based)
Result<-list() 

for (j in 1:5) {
load(paste("df.imputed",j))

result<-glmer(valid~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+rreligion+church.attendance+
			unionm+voted.past+
			duty+	efficacy+
			initial.seat.margin+
			(1|constit)+(1|electn)+(1|cohort.franklin),
				data=df, family = binomial("probit")) 

Result[[j]]<-result

print(j)
}

## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5


Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.Table4.Col2.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.Table4.Col2.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.Table4.Col2.ML

write.csv(Results.Table4.Col2.ML, file="Results.Table4.Col2.ML.csv")
rm(list=ls())

 
# Table 4 - Column 3 (Likelihood-based)
Result<-list()
for (j in 1:5) {
load(paste("df.imputed",j))

result<-glmer(valid~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+rreligion+church.attendance+
			unionm+voted.past+
			pstrong+duty+efficacy+
			initial.seat.margin+
			(1|constit)+(1|electn)+(1|cohort.franklin),
				data=df, family = binomial("probit")) 

Result[[j]]<-result

print(j)
}


## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5


Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}


Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.Table4.Col3.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.Table4.Col3.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.Table4.Col3.ML

write.csv(Results.Table4.Col3.ML, file="Results.Table4.Col3.ML.csv")
rm(list=ls())


# Table 4 - Column 4 (Likelihood-based)
Result<-list() 

for (j in 1:5) {
load(paste("df.imputed",j))

result<-glmer(valid~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+rreligion+church.attendance+
			unionm+voted.past+
			pstrong+I(new.cohort*pstrong)+
			duty+I(new.cohort*duty)+
			efficacy+I(new.cohort*efficacy)+
			initial.seat.margin+
			(1|constit)+(1|electn)+(1|cohort.franklin),
				data=df, family = binomial("probit")) 

Result[[j]]<-result

print(j)
}

save(Result, file="Table4.Column4")


## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5


Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.Table4.Col4.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.Table4.Col4.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.Table4.Col4.ML

write.csv(Results.Table4.Col4.ML, file="Results.Table4.Col4.ML.csv")
rm(list=ls())


################################## FIGURE 4 #####################################
# Multiple plot function (coho rt-specific and election-specific effects in a single figure)
#
# ggplot objects can be passed in ..., or to plotlist (as a list of ggplot objects)
# - cols:   Number of columns in layout
# - layout: A matrix specifying the layout. If present, 'cols' is ignored.
#
# If the layout is something like matrix(c(1,2,3,3), nrow=2, byrow=TRUE),
# then plot 1 will go in the upper left, 2 will go in the upper right, and
# 3 will go all the way across the bottom.
#
multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
  require(grid)

  # Make a list from the ... arguments and plotlist
  plots <- c(list(...), plotlist)

  numPlots = length(plots)

  # If layout is NULL, then use 'cols' to determine layout
  if (is.null(layout)) {
    # Make the panel
    # ncol: Number of columns of plots
    # nrow: Number of rows needed, calculated from # of cols
    layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
                    ncol = cols, nrow = ceiling(numPlots/cols))
  }

 if (numPlots==1) {
    print(plots[[1]])

  } else {
    # Set up the page
    grid.newpage()
    pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))

    # Make each plot, in the correct location
    for (i in 1:numPlots) {
      # Get the i,j matrix positions of the regions that contain this subplot
      matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))

      print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
                                      layout.pos.col = matchidx$col))
    }
  }
}

#### COUNTERFACTUAL COHORT EFFECTS

Null.cohort<-c()
Effect.cohort<-c()
Null.election<-c()
Effect.election<-c()

for (imp in 1:5) {
load(paste("Results.Table4.Col4.MCMC.Imputed", imp))

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"pstrong", "duty", "efficacy", "initial.seat.margin",
		"valid", "electn", "constit", "cohort.franklin"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))
Cohort<-as.numeric(factor(df$cohort.franklin), levels=unique(df$cohort.franklin))

X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past, df$initial.seat.margin,
		df$pstrong, I(df$pstrong*df$new.cohort),
		df$duty, I(df$duty*df$new.cohort),
		df$efficacy, I(df$efficacy*df$new.cohort)
)

mean.cohorts<-apply(Results$B.cohort,1,mean)
mean.elections<-apply(Results$B.election,1,mean)

null.cohort<-c()
effect.cohort<-c()

null.election<-c()
effect.election<-c()

null.cohort<-cbind(null.cohort,apply(sapply(1:dim(Results$Beta)[1], function(s)
	pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area]+mean.cohorts[s])),2,mean))


for (k in 1:length(unique(Cohort))) {
effect.cohort<-cbind(effect.cohort, apply(sapply(1:dim(Results$Beta)[1], function(s)
	pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area]+Results$B.cohort[s,k])),2,mean))
}

null.election<-cbind(null.election,apply(sapply(1:dim(Results$Beta)[1], function(s)
	pnorm(X%*%Results$Beta[s,]+mean.elections[s]+
	Results$B.area[s,Area]+Results$B.cohort[s, Cohort])),2,mean))

for (k in 1:length(unique(Election))) {
effect.election<-cbind(effect.election, apply(sapply(1:dim(Results$Beta)[1], function(s)
	pnorm(X%*%Results$Beta[s,]+Results$B.election[s,k]+
	Results$B.area[s,Area]+Results$B.cohort[s,Cohort])),2,mean))
}


Null.cohort<-rbind(Null.cohort, null.cohort)
Effect.cohort<-rbind(Effect.cohort, effect.cohort)

Null.election<-rbind(Null.election, null.election)
Effect.election<-rbind(Effect.election, effect.election)

print(imp)
}


Cohort.reffects<-data.frame(cbind(apply(sapply(1:ncol(Effect.cohort), function(s) Effect.cohort[,s]-Null.cohort),2,mean)*100,
		HPDinterval(as.mcmc(sapply(1:ncol(Effect.cohort), function(s) Effect.cohort[,s]-Null.cohort)), p=0.9)*100))
Cohort.reffects<-cbind(c("Pre-1955","1959", "1964", "1966",
			"1970", "1974", "1979", "1983", "1987",
			"1992", "1997", "2001", "Post-2001"), Cohort.reffects)
names(Cohort.reffects)<-c("Cohort", "Mean", "lower", "upper")
Cohort.reffects$Cohort<-factor(Cohort.reffects$Cohort, 
	levels=c("Pre-1955",
		"1959",
		"1964",
		"1966",
		"1970",
		"1974",
		"1979",
		"1983",
		"1987",
		"1992",
		"1997",
		"2001",
		"Post-2001"))

Election.reffects<-data.frame(cbind(apply(sapply(1:ncol(Effect.election), function(s) Effect.election[,s]-Null.election),2,mean)*100,
		HPDinterval(as.mcmc(sapply(1:ncol(Effect.election), function(s) Effect.election[,s]-Null.election)), p=0.9)*100))
Election.reffects<-cbind(c("1964", "1966", "1970", "1974(February)", 
			"1974(October)", "1979", "1983", "1987", "1992",
			"1997", "2001", "2005", "2010"), Election.reffects)
names(Election.reffects)<-c("Election", "Mean", "lower", "upper")


p.1<-ggplot(Cohort.reffects, aes(x=Cohort, y=Mean)) + 
    geom_errorbar(aes(ymin=lower, ymax=upper), width=.2) +
   ylab("")+xlab("")+ geom_point()+ 
scale_x_discrete(breaks = c("Pre-1955", "1966", "1979", "1992", "Post-2001"))+
ggtitle("Cohort-specific effects")+
geom_hline(aes(yintercept = 0), 
		linetype = "longdash", col="gray20")
p.1<-p.1+theme_bw()

p.2<-ggplot(Election.reffects, aes(x=Election, y=Mean)) + 
    geom_errorbar(aes(ymin=lower, ymax=upper), width=.2) +
   ylab("")+xlab("")+ geom_point()+
scale_x_discrete(breaks = c("1964", "1970", "1979", "1992", "2001", "2010"))+
ggtitle("Election-specific effects")+
geom_hline(aes(yintercept = 0), 
		linetype = "longdash", col="gray20")
p.2<-p.2+theme_bw()


multiplot(p.1, p.2, cols=2)

rm(list=ls())

############# ADDITIONAL RESULTS PRESENTED IN THE ONLINE APPENDIX #############

################################## FIGURE A.1 #####################################
## ROC curves

rocdata <- function(grp, pred){
  # Produces x and y co-ordinates for ROC curve plot
  # Arguments: grp - labels classifying subject status
  #            pred - values of each observation
  # Output: List with 2 components:
  #         roc = data.frame with x and y co-ordinates of plot
  #         stats = data.frame containing: area under ROC curve, p value, upper and lower 95% confidence interval
 
  grp <- as.factor(grp)
  if (length(pred) != length(grp)) {
    stop("The number of classifiers must match the number of data points")
  } 
 
  if (length(levels(grp)) != 2) {
    stop("There must only be 2 values for the classifier")
  }
 
  cut <- unique(pred)

 tp <- sapply(cut, function(x) length(which(pred > x & grp == levels(grp)[2])))
  fn <- sapply(cut, function(x) length(which(pred < x & grp == levels(grp)[2])))
  fp <- sapply(cut, function(x) length(which(pred > x & grp == levels(grp)[1])))
  tn <- sapply(cut, function(x) length(which(pred < x & grp == levels(grp)[1])))

  tpr <- tp / (tp + fn)
  fpr <- fp / (fp + tn)
  acc<- (tp+tn)/(length(grp[grp==1])+length(grp[grp==0]))
  tnr<- tn/(fp+tn)
  ppv<- tp/(tp+fp)

  roc = data.frame(x = fpr, y = tpr)
  roc <- roc[order(roc$x, roc$y),]
 
  i <- 2:nrow(roc)
  auc <- (roc$x[i] - roc$x[i - 1]) %*% (roc$y[i] + roc$y[i - 1])/2
 
  pos <- pred[grp == levels(grp)[2]]
  neg <- pred[grp == levels(grp)[1]]
  q1 <- auc/(2-auc)
  q2 <- (2*auc^2)/(1+auc)
  se.auc <- sqrt(((auc * (1 - auc)) + ((length(pos) -1)*(q1 - auc^2)) + ((length(neg) -1)*(q2 - auc^2)))/(length(pos)*length(neg)))
  ci.upper <- auc + (se.auc * 0.96)
  ci.lower <- auc - (se.auc * 0.96)
 
  se.auc.null <- sqrt((1 + length(pos) + length(neg))/(12*length(pos)*length(neg)))
  z <- (auc - 0.5)/se.auc.null
  p <- 2*pnorm(-abs(z))
 
  stats <- data.frame (auc = auc,
                       p.value = p,
                       ci.upper = ci.upper,
                       ci.lower = ci.lower,
				fpr=fpr,
				tpr=tpr,
				acc=acc, 
				tnr=tnr,
				ppv=ppv
                       )
 
  return (list(roc = roc, stats = stats))
}


###### Figure A.1, upper left panel
prediction<-c()
depvar<-c()
for (imp in 1:5) {

load(paste("Results.Table2.Col1.MCMC.Imputed",imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise",
		"vote", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise
)

y<-df$vote


mean.Beta<-apply(Results$Beta,2,mean)
mean.B.election<-apply(Results$B.election,2,mean)
mean.B.area<-apply(Results$B.area,2,mean)


prediction<-cbind(prediction, pnorm(X%*%mean.Beta+mean.B.election[Election]+
			mean.B.area[Area]))
depvar<-cbind(depvar,y)

print(imp)
}

AUC.Tabl2.Col1<-sapply(1:5, function(j) rocdata(depvar[,j], prediction[,j])$stats$auc)
rocdata.Table2.Col1<-rocdata(ifelse(apply(depvar,1,mean)>0.5,1,0), apply(prediction,1,mean))


###### Figure A.1, upper right panel
# Table 2, Column 2
prediction<-c()
depvar<-c()
for (imp in 1:5) {

load(paste("Results.Table2.Col2.MCMC.Imputed",imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"vote", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past
)

y<-df$vote

mean.Beta<-apply(Results$Beta,2,mean)
mean.B.election<-apply(Results$B.election,2,mean)
mean.B.area<-apply(Results$B.area,2,mean)


prediction<-cbind(prediction, pnorm(X%*%mean.Beta+mean.B.election[Election]+
			mean.B.area[Area]))
depvar<-cbind(depvar,y)

print(imp)
}

AUC.Table2.Col2<-sapply(1:5, function(j) rocdata(depvar[,j], prediction[,j])$stats$auc)
rocdata.Table2.Col2<-rocdata(ifelse(apply(depvar,1,mean)>0.5,1,0), apply(prediction,1,mean))

# Table 2, Column 3
prediction<-c()
depvar<-c()
for (imp in 1:5) {

load(paste("Results.Table2.Col3.MCMC.Imputed",imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"vote", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past
)

y<-df$vote


mean.Beta<-apply(Results$Beta,2,mean)
mean.B.election<-apply(Results$B.election,2,mean)
mean.B.area<-apply(Results$B.area,2,mean)


prediction<-cbind(prediction,pnorm(X%*%mean.Beta+mean.B.election[Election]+
			mean.B.area[Area]))
depvar<-cbind(depvar,y)

print(imp)
}

AUC.Table2.Col3<-sapply(1:5, function(j) rocdata(depvar[,j], prediction[,j])$stats$auc)
rocdata.Table2.Col3<-rocdata(ifelse(apply(depvar,1,mean)>0.5,1,0), apply(prediction,1,mean))


###### Figure A.1, lower left panel
# Table 2 Column 4
prediction<-c()
depvar<-c()
for (imp in 1:5) {

load(paste("Results.Table2.Col4.MCMC.Imputed",imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise",
		"valid", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise
)

y<-df$valid


mean.Beta<-apply(Results$Beta,2,mean)
mean.B.election<-apply(Results$B.election,2,mean)
mean.B.area<-apply(Results$B.area,2,mean)


prediction<-cbind(prediction, pnorm(X%*%mean.Beta+mean.B.election[Election]+
			mean.B.area[Area]))
depvar<-cbind(depvar,y)

print(imp)
}

AUC.Table2.Col4<-sapply(1:5, function(j) rocdata(depvar[,j], prediction[,j])$stats$auc)
rocdata.Table2.Col4<-rocdata(ifelse(apply(depvar,1,mean)>0.5,1,0), apply(prediction,1,mean))


###### Figure A.1, lower right panel
# Table 2 Column 5
prediction<-c()
depvar<-c()

for (imp in 1:5) {

load(paste("Results.Table2.Col5.MCMC.Imputed",imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"valid", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past
)

y<-df$valid

mean.Beta<-apply(Results$Beta,2,mean)
mean.B.election<-apply(Results$B.election,2,mean)
mean.B.area<-apply(Results$B.area,2,mean)


prediction<-cbind(prediction,pnorm(X%*%mean.Beta+mean.B.election[Election]+
			mean.B.area[Area]))
depvar<-cbind(depvar,y)

print(imp)
}

AUC.Table2.Col5<-sapply(1:5, function(j) rocdata(depvar[,j], prediction[,j])$stats$auc)
rocdata.Table2.Col5<-rocdata(ifelse(apply(depvar,1,mean)>0.5,1,0), apply(prediction,1,mean))

# Table 2 Column 6
prediction<-c()
depvar<-c()

for (imp in 1:5) {

load(paste("Results.Table2.Col6.MCMC.Imputed",imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"valid", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past
)

y<-df$valid

mean.Beta<-apply(Results$Beta,2,mean)
mean.B.election<-apply(Results$B.election,2,mean)
mean.B.area<-apply(Results$B.area,2,mean)


prediction<-cbind(prediction,pnorm(X%*%mean.Beta+mean.B.election[Election]+
			mean.B.area[Area]))
depvar<-cbind(depvar,y)

print(imp)
}

AUC.Table2.Col6<-sapply(1:5, function(j) rocdata(depvar[,j], prediction[,j])$stats$auc)
rocdata.Table2.Col6<-rocdata(ifelse(apply(depvar,1,mean)>0.5,1,0), apply(prediction,1,mean))


#### ROC curves #####
par(mfrow=c(2,2))
par(mar=c(4,4,3,2))


plot(rocdata.Table2.Col1$roc[,1], rocdata.Table2.Col1$roc[,2], 
	axes=FALSE, type='l', lwd=2, xlab='', ylab='')
box()
lines(seq(0,1,by=0.01), seq(0,1,by=0.01), lty=2)
axis(1, at = seq(0,1,by=0.1), labels = seq(0,1,by=0.1), ticks=TRUE, 
	cex.axis=0.9)
axis(2, at = seq(0,1,by=0.1), labels = seq(0,1,by=0.1), ticks=TRUE, 
	cex.axis=0.8)
mtext("True positives", cex=0.9, side=2, padj=-3)
mtext("False positives", side=1, cex=0.9, padj=3)
#text(x=0.5, y=0.2, paste("Area under the curve", round(mean(rocdata.Table2.Col1$stats$auc),digits=2)))
mtext("Table 2, Column 1", side=3, padj=-0.5)
#legend("bottomright",
#legend=c(paste("Column 1, AUC=",round(mean(rocdata.Table2.Col1$stats$auc),digits=3))),
#fill=c("black"), border = "white", cex=0.8,
#bty='n') 

####
plot(rocdata.Table2.Col2$roc[,1], rocdata.Table2.Col2$roc[,2], 
	axes=FALSE, type='l', lwd=2, xlab='', ylab='')
lines(rocdata.Table2.Col3$roc[,1], rocdata.Table2.Col3$roc[,2], 
	col='gray61', lwd=2)
box()
lines(seq(0,1,by=0.01), seq(0,1,by=0.01), lty=2)
axis(1, at = seq(0,1,by=0.1), labels = seq(0,1,by=0.1), ticks=TRUE, 
	cex.axis=0.9)
axis(2, at = seq(0,1,by=0.1), labels = seq(0,1,by=0.1), ticks=TRUE, 
	cex.axis=0.8)
mtext("True positives", cex=0.9, side=2, padj=-3)
mtext("False positives", side=1, cex=0.9, padj=3)
#text(x=0.8, y=0.2, paste("Area under the curve", round(mean(rocdata.Table2.Col2$stats$auc),digits=3)))
#text(x=0.8, y=0.15, paste("Area under the curve", round(mean(rocdata.Table2.Col3$stats$auc),digits=3)), col="gray61")
mtext("Table 2, Columns 2 and 3", side=3, padj=-.5)


legend("bottomright",
legend=c("Column 2",
#, AUC=",round(mean(rocdata.Table2.Col2$stats$auc),digits=3))
"Column 3"#, AUC=",round(mean(rocdata.Table2.Col3$stats$auc),digits=3)))
),
fill=c("black","gray61" ), border = "white", cex=0.8,
y.intersp = 1, bty='n') 

###

plot(rocdata.Table2.Col4$roc[,1], rocdata.Table2.Col4$roc[,2], 
	axes=FALSE, type='l', lwd=2, xlab='', ylab='')
box()
lines(seq(0,1,by=0.01), seq(0,1,by=0.01), lty=2)
axis(1, at = seq(0,1,by=0.1), labels = seq(0,1,by=0.1), ticks=TRUE, 
	cex.axis=0.9)
axis(2, at = seq(0,1,by=0.1), labels = seq(0,1,by=0.1), ticks=TRUE, 
	cex.axis=0.8)
mtext("True positives", cex=0.9, side=2, padj=-3)
mtext("False positives", side=1, cex=0.9, padj=3)
#text(x=0.5, y=0.2, paste("Area under the curve", round(mean(rocdata.Table2.Col1$stats$auc),digits=2)))
mtext("Table 2, Column 4", side=3, padj=-.5)
#legend("bottomright",
#legend=c("paste("Column 4, AUC=",round(mean(rocdata.Table2.Col4$stats$auc),digits=3))),
#fill=c("black"), border = "white", cex=0.8,
#bty='n')

####
plot(rocdata.Table2.Col5$roc[,1], rocdata.Table2.Col5$roc[,2], 
	axes=FALSE, type='l', lwd=2, xlab='', ylab='')
lines(rocdata.Table2.Col6$roc[,1], rocdata.Table2.Col6$roc[,2], 
	col='gray61', lwd=2)
box()
lines(seq(0,1,by=0.01), seq(0,1,by=0.01), lty=2)
axis(1, at = seq(0,1,by=0.1), labels = seq(0,1,by=0.1), ticks=TRUE, 
	cex.axis=0.9)
axis(2, at = seq(0,1,by=0.1), labels = seq(0,1,by=0.1), ticks=TRUE, 
	cex.axis=0.8)
mtext("True positives", cex=0.9, side=2, padj=-3)
mtext("False positives", side=1, cex=0.9, padj=3)
#text(x=0.8, y=0.2, paste("Area under the curve", round(mean(rocdata.Table2.Col2$stats$auc),digits=3)))
#text(x=0.8, y=0.15, paste("Area under the curve", round(mean(rocdata.Table2.Col3$stats$auc),digits=3)), col="gray61")
mtext("Table 2, Columns 5 and 6", side=3, padj=-.5)

legend("bottomright",
legend=c("Column 5","Column 6")
#paste("Column 5, AUC=",round(mean(rocdata.Table2.Col5$stats$auc),digits=3)),
#paste("Column 6, AUC=",round(mean(rocdata.Table2.Col6$stats$auc),digits=3)))
,
fill=c("black","gray61"
), border = "white", cex=0.8,
y.intersp = 1, bty='n')

rm(list=ls())


################################# TABLE A.1 ####################################
######## First we use MCMC estimation 
####### Then we use likelihood-based estimation for robustness


# Table A.1 - Column 1 (MCMC)
load("completecase.reported")

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise",
		"vote", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))



# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise
)

y<-df$vote

#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Manifesto Benoit", "New.cohort*Manifesto",
			"Young Initiation", "Fem. Franchising"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file="Results.TableA1.Col1.MCMC")


rm(list=ls())

# Display results
load("Results.TableA1.Col1.MCMC")
Beta<-Results$Beta
Estimates.TableA1.Col1.MCMC<-cbind(apply(Beta,2,mean), HPDinterval(as.mcmc(Beta), p=0.9))
colnames(Estimates.TableA1.Col1.MCMC)<-c("Estimate", "Lower90", "Upper90")

### Order the rows to make them appear as in Table A1, Col 1
Estimates.TableA1.Col1.MCMC<-Estimates.TableA1.Col1.MCMC[c(2:4,7:8,5:6,9:12,1),]

# Display MCMC estimates
round(Estimates.TableA1.Col1.MCMC, digits=3)

save(Beta, file="Fixed-effects MCMC estimates.TableA1.Col1")

# Compute DIC

load("completecase.reported")

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise",
		"vote", "electn", "constit"))
df<-na.omit(df)



Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))



X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise
)

y<-df$vote



D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)

D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)


DIC<- -2*mean(D)+(-2*mean(D)-D.bar)
DIC

rm(list=ls())

####
#TABLE A.1 - Column 2 (MCMC)
load("completecase.reported")

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise",
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "unionm", "voted.past",
		"vote", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, 
		df$unionm, df$voted.past
)

y<-df$vote


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Manifesto Benoit", "New.cohort*Manifesto",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", 
			"Union", "Voted.past"
			)


 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file="Results.TableA1.Col2.MCMC")

rm(list=ls())

# Display results
load("Results.TableA1.Col2.MCMC")

Beta<-Results$Beta
Estimates.TableA1.Col2.MCMC<-cbind(apply(Beta,2,mean), HPDinterval(as.mcmc(Beta), p=0.9))
colnames(Estimates.TableA1.Col2.MCMC)<-c("Estimate", "Lower90", "Upper90")

### Order the rows to make them appear as in Table A1, Col 1
Estimates.TableA1.Col2.MCMC<-Estimates.TableA1.Col2.MCMC[c(2:4,7:8,5:6,9:13,15,14,16:21,1),]

# Display MCMC estimates
round(Estimates.TableA1.Col2.MCMC, digits=3)

save(Beta, file="Fixed-effects MCMC estimates.TableA1.Col2")


# Compute DIC
load("completecase.reported")

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise",
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "unionm", "voted.past",
		"vote", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, 
		df$unionm, df$voted.past
)

y<-df$vote


D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)



DIC<- -2*mean(D)+(-2*mean(D)-D.bar)
DIC

rm(list=ls())

####
#TABLE A.1 - Column 3 (MCMC)
load("completecase.reported")

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise",
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "unionm", "voted.past",
		"vote", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, 
		df$unionm, df$voted.past
)

y<-df$vote


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party DIF", "New.cohort* Party DIF",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", 
			"Union", "Voted.past"
			)


 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file="Results.TableA1.Col3.MCMC")


rm(list=ls())

# Display results
load("Results.TableA1.Col3.MCMC")

Beta<-Results$Beta
Estimates.TableA1.Col3.MCMC<-cbind(apply(Beta,2,mean), HPDinterval(as.mcmc(Beta), p=0.9))
colnames(Estimates.TableA1.Col3.MCMC)<-c("Estimate", "Lower90", "Upper90")

### Order the rows to make them appear as in Table A1, Col 3
Estimates.TableA1.Col3.MCMC<-Estimates.TableA1.Col3.MCMC[c(2:4,7:8,5:6,9:13,15,14,16:21,1),]

# Display MCMC estimates
round(Estimates.TableA1.Col3.MCMC, digits=3)


save(Beta, file="Fixed-effects MCMC estimates.TableA1.Col3")

# Compute DIC
load("completecase.reported")

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise",
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "unionm", "voted.past",
		"vote", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, 
		df$unionm, df$voted.past
)

y<-df$vote

D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)




DIC<- -2*mean(D)+(-2*mean(D)-D.bar)
DIC

rm(list=ls())

######
# Table A.1 - Column 4 (MCMC)
load("completecase.validated")

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise",
		"valid", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))



# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise
)

y<-df$valid

#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Manifesto Benoit", "New.cohort*Manifesto",
			"Young Initiation", "Fem. Franchising"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file="Results.TableA1.Col4.MCMC")


rm(list=ls())
load("Results.TableA1.Col4.MCMC")

Beta<-Results$Beta
Estimates.TableA1.Col4.MCMC<-cbind(apply(Beta,2,mean), HPDinterval(as.mcmc(Beta), p=0.9))
colnames(Estimates.TableA1.Col4.MCMC)<-c("Estimate", "Lower90", "Upper90")

### Order the rows to make them appear as in Table A1, Col 4
Estimates.TableA1.Col4.MCMC<-Estimates.TableA1.Col4.MCMC[c(2:4,7:8,5:6,9:12,1),]

# Display MCMC estimates
round(Estimates.TableA1.Col4.MCMC, digits=3)

save(Beta, file="Fixed-effects MCMC estimates.TableA1.Col4")


# Compute DIC

load("completecase.validated")

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise",
		"valid", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))



X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise
)

y<-df$valid

D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)



DIC<- -2*mean(D)+(-2*mean(D)-D.bar)
DIC

rm(list=ls())

####
#TABLE A.1 - Column 5 (MCMC)
load("completecase.validated")

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise",
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "unionm", "voted.past",
		"valid", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, 
		df$unionm, df$voted.past
)

y<-df$valid


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Manifesto Benoit", "New.cohort*Manifesto",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", 
			"Union", "Voted.past"
			)


 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file="Results.TableA1.Col5.MCMC")


rm(list=ls())

# Display results
load("Results.TableA1.Col5.MCMC")

Beta<-Results$Beta
Estimates.TableA1.Col5.MCMC<-cbind(apply(Beta,2,mean), HPDinterval(as.mcmc(Beta), p=0.9))
colnames(Estimates.TableA1.Col5.MCMC)<-c("Estimate", "Lower90", "Upper90")

### Order the rows to make them appear as in Table A1, Col 5
Estimates.TableA1.Col5.MCMC<-Estimates.TableA1.Col5.MCMC[c(2:4,7:8,5:6,9:13,15,14,16:21,1),]

# Display MCMC estimates
round(Estimates.TableA1.Col5.MCMC, digits=3)


save(Beta, file="Fixed-effects MCMC estimates.TableA1.Col5")

# Compute DIC
load("completecase.validated")

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise",
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "unionm", "voted.past",
		"valid", "electn", "constit"))
df<-na.omit(df)

X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, 
		df$unionm, df$voted.past
)

y<-df$valid




Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, 
		df$unionm, df$voted.past
)

y<-df$valid



D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)



DIC<- -2*mean(D)+(-2*mean(D)-D.bar)
DIC
rm(list=ls())

#TABLE A.1 - Column 6 (MCMC)
load("completecase.validated")

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise",
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "unionm", "voted.past",
		"valid", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, 
		df$unionm, df$voted.past
)

y<-df$valid


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party DIF", "New.cohort*Party DIF",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", 
			"Union", "Voted.past"
			)


 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file="Results.TableA1.Col6.MCMC")


rm(list=ls())

# Display results
load("Results.TableA1.Col6.MCMC")

Beta<-Results$Beta
Estimates.TableA1.Col6.MCMC<-cbind(apply(Beta,2,mean), HPDinterval(as.mcmc(Beta), p=0.9))
colnames(Estimates.TableA1.Col6.MCMC)<-c("Estimate", "Lower90", "Upper90")

### Order the rows to make them appear as in Table A1, Col 6
Estimates.TableA1.Col6.MCMC<-Estimates.TableA1.Col6.MCMC[c(2:4,7:8,5:6,9:13,15,14,16:21,1),]

# Display MCMC estimates
round(Estimates.TableA1.Col6.MCMC, digits=3)


save(Beta, file="Fixed-effects MCMC estimates.TableA1.Col6")

# Compute DIC

load("completecase.validated")
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise",
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "unionm", "voted.past",
		"valid", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, 
		df$unionm, df$voted.past
)

y<-df$valid

D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)



D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)



DIC<- -2*mean(D)+(-2*mean(D)-D.bar)
DIC

rm(list=ls())

############## Now repeat estimation using likelihood-based methods ##########

# Table A.1 - Column 1(Likelihood-based)
load("completecase.reported")
result<-glmer(vote~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			logrile+I(new.cohort*logrile)+
			young.initiation+fem.franchise+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 


Results.TableA1.Col1.ML<-cbind(fixef(result), sqrt(diag(vcov(result))),
cbind(fixef(result)-1.645*sqrt(diag(vcov(result))),
	fixef(result)+1.645*sqrt(diag(vcov(result))),
cbind(fixef(result)-1.945*sqrt(diag(vcov(result))),
	fixef(result)+1.945*sqrt(diag(vcov(result))),
cbind(fixef(result)-2.58*sqrt(diag(vcov(result))),
	fixef(result)+2.58*sqrt(diag(vcov(result)))))))

colnames(Results.TableA1.Col1.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

#Display results
Results.TableA1.Col1.ML

# Display significance "stars"
Result<-Results.TableA1.Col1.ML

Significance.TableA1.Col1.ML<-as.matrix(cbind(rownames(Result),
c(ifelse(rowSums(sign(Result[,7:8]))!=0,"***",
ifelse(rowSums(sign(Result[,5:6]))!=0,"**",
ifelse(rowSums(sign(Result[,3:4]))!=0,"*"," "))))))
colnames(Significance.TableA1.Col1.ML)<-c("Regressor", "Asterisks")

### Order the rows to make them appear as in Table A1, Col 1
Significance.TableA1.Col1.ML<-Significance.TableA1.Col1.ML[c(2:4,7:8,5:6,9:12,1),]

Significance.TableA1.Col1.ML


write.csv(Results.TableA1.Col1.ML, file="Results.TableA1.Col1.ML.csv")

# Table A.1 - Column 2(Likelihood-based)
result<-glmer(vote~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			logrile+I(new.cohort*logrile)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+unionm+voted.past+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 

Results.TableA1.Col2.ML<-cbind(fixef(result), sqrt(diag(vcov(result))),
cbind(fixef(result)-1.645*sqrt(diag(vcov(result))),
	fixef(result)+1.645*sqrt(diag(vcov(result))),
cbind(fixef(result)-1.945*sqrt(diag(vcov(result))),
	fixef(result)+1.945*sqrt(diag(vcov(result))),
cbind(fixef(result)-2.58*sqrt(diag(vcov(result))),
	fixef(result)+2.58*sqrt(diag(vcov(result)))))))

colnames(Results.TableA1.Col2.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

#Display results
Results.TableA1.Col2.ML


# Display significance "stars"
Result<-Results.TableA1.Col2.ML

Significance.TableA1.Col2.ML<-as.matrix(cbind(rownames(Result),
c(ifelse(rowSums(sign(Result[,7:8]))!=0,"***",
ifelse(rowSums(sign(Result[,5:6]))!=0,"**",
ifelse(rowSums(sign(Result[,3:4]))!=0,"*"," "))))))
colnames(Significance.TableA1.Col2.ML)<-c("Regressor", "Asterisks")

### Order the rows to make them appear as in Table A1, Col 2
Significance.TableA1.Col2.ML<-Significance.TableA1.Col2.ML[c(2:4,7:8,5:6,9:13,15,14,16:21,1),]

Significance.TableA1.Col2.ML


write.csv(Results.TableA1.Col2.ML, file="Results.TableA1.Col2.ML.csv")


# Table A.1 - Column 3 (Likelihood-based)
result<-glmer(vote~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+
			unionm+voted.past+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 

Results.TableA1.Col3.ML<-cbind(fixef(result), sqrt(diag(vcov(result))),
cbind(fixef(result)-1.645*sqrt(diag(vcov(result))),
	fixef(result)+1.645*sqrt(diag(vcov(result))),
cbind(fixef(result)-1.945*sqrt(diag(vcov(result))),
	fixef(result)+1.945*sqrt(diag(vcov(result))),
cbind(fixef(result)-2.58*sqrt(diag(vcov(result))),
	fixef(result)+2.58*sqrt(diag(vcov(result)))))))

colnames(Results.TableA1.Col3.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

#Display results
Results.TableA1.Col3.ML

# Display significance "stars"
Result<-Results.TableA1.Col3.ML

Significance.TableA1.Col3.ML<-as.matrix(cbind(rownames(Result),
c(ifelse(rowSums(sign(Result[,7:8]))!=0,"***",
ifelse(rowSums(sign(Result[,5:6]))!=0,"**",
ifelse(rowSums(sign(Result[,3:4]))!=0,"*"," "))))))
colnames(Significance.TableA1.Col3.ML)<-c("Regressor", "Asterisks")

### Order the rows to make them appear as in Table A1, Col 3
Significance.TableA1.Col3.ML<-Significance.TableA1.Col3.ML[c(2:4,7:8,5:6,9:13,15,14,16:21,1),]

Significance.TableA1.Col3.ML

write.csv(Results.TableA1.Col3.ML, file="Results.TableA1.Col3.ML.csv")
rm(list=ls())



# Table A.1 - Column 4 (Likelihood-based)
load("completecase.validated")
result<-glmer(valid~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			logrile+I(new.cohort*logrile)+
			young.initiation+fem.franchise+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 


Results.TableA1.Col4.ML<-cbind(fixef(result), sqrt(diag(vcov(result))),
cbind(fixef(result)-1.645*sqrt(diag(vcov(result))),
	fixef(result)+1.645*sqrt(diag(vcov(result))),
cbind(fixef(result)-1.945*sqrt(diag(vcov(result))),
	fixef(result)+1.945*sqrt(diag(vcov(result))),
cbind(fixef(result)-2.58*sqrt(diag(vcov(result))),
	fixef(result)+2.58*sqrt(diag(vcov(result)))))))

colnames(Results.TableA1.Col4.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

#Display results
Results.TableA1.Col4.ML

# Display significance "stars"
Result<-Results.TableA1.Col4.ML

Significance.TableA1.Col4.ML<-as.matrix(cbind(rownames(Result),
c(ifelse(rowSums(sign(Result[,7:8]))!=0,"***",
ifelse(rowSums(sign(Result[,5:6]))!=0,"**",
ifelse(rowSums(sign(Result[,3:4]))!=0,"*"," "))))))
colnames(Significance.TableA1.Col4.ML)<-c("Regressor", "Asterisks")

### Order the rows to make them appear as in Table A1, Col 4
Significance.TableA1.Col4.ML<-Significance.TableA1.Col4.ML[c(2:4,7:8,5:6,9:12,1),]

Significance.TableA1.Col4.ML

write.csv(Results.TableA1.Col4.ML, file="Results.TableA1.Col4.ML.csv")


# Table A.1 - Column 5 (Likelihood-based)
result<-glmer(valid~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			logrile+I(new.cohort*logrile)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+unionm+voted.past+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 

Results.TableA1.Col5.ML<-cbind(fixef(result), sqrt(diag(vcov(result))),
cbind(fixef(result)-1.645*sqrt(diag(vcov(result))),
	fixef(result)+1.645*sqrt(diag(vcov(result))),
cbind(fixef(result)-1.945*sqrt(diag(vcov(result))),
	fixef(result)+1.945*sqrt(diag(vcov(result))),
cbind(fixef(result)-2.58*sqrt(diag(vcov(result))),
	fixef(result)+2.58*sqrt(diag(vcov(result)))))))

colnames(Results.TableA1.Col5.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")


#Display results
Results.TableA1.Col5.ML

#Display significance "stars"
Result<-Results.TableA1.Col5.ML

Significance.TableA1.Col5.ML<-as.matrix(cbind(rownames(Result),
c(ifelse(rowSums(sign(Result[,7:8]))!=0,"***",
ifelse(rowSums(sign(Result[,5:6]))!=0,"**",
ifelse(rowSums(sign(Result[,3:4]))!=0,"*"," "))))))
colnames(Significance.TableA1.Col5.ML)<-c("Regressor", "Asterisks")

### Order the rows to make them appear as in Table A1, Col 5
Significance.TableA1.Col5.ML<-Significance.TableA1.Col5.ML[c(2:4,7:8,5:6,9:13,15,14,16:21,1),]

Significance.TableA1.Col5.ML


write.csv(Results.TableA1.Col5.ML, file="Results.TableA1.Col5.ML.csv")


# Table A.1 - Column 6 (Likelihood-based)
result<-glmer(valid~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+
			unionm+voted.past+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 

Results.TableA1.Col6.ML<-cbind(fixef(result), sqrt(diag(vcov(result))),
cbind(fixef(result)-1.645*sqrt(diag(vcov(result))),
	fixef(result)+1.645*sqrt(diag(vcov(result))),
cbind(fixef(result)-1.945*sqrt(diag(vcov(result))),
	fixef(result)+1.945*sqrt(diag(vcov(result))),
cbind(fixef(result)-2.58*sqrt(diag(vcov(result))),
	fixef(result)+2.58*sqrt(diag(vcov(result)))))))

colnames(Results.TableA1.Col6.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

#Display results
Results.TableA1.Col6.ML

#Display significance "stars"
Result<-Results.TableA1.Col6.ML

Significance.TableA1.Col6.ML<-as.matrix(cbind(rownames(Result),
c(ifelse(rowSums(sign(Result[,7:8]))!=0,"***",
ifelse(rowSums(sign(Result[,5:6]))!=0,"**",
ifelse(rowSums(sign(Result[,3:4]))!=0,"*"," "))))))
colnames(Significance.TableA1.Col6.ML)<-c("Regressor", "Asterisks")

### Order the rows to make them appear as in Table A1, Col 6
Significance.TableA1.Col6.ML<-Significance.TableA1.Col6.ML[c(2:4,7:8,5:6,9:13,15,14,16:21,1),]

Significance.TableA1.Col6.ML


write.csv(Results.TableA1.Col6.ML, file="Results.TableA1.Col6.ML.csv")
rm(list=ls())

############################## TABLE A.2 ###########################################
######## First we use MCMC estimation 
####### Then we use likelihood-based estimation for robustness

#TABLE A.2 - Column 1 (MCMC)
for (imp in 1:5) {
load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"vote", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))

# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1

X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation, df$fem.franchise, 
		df$log.age, I(df$new.cohort*df$log.age),
		df$female,I(df$new.cohort*df$female),
		df$eduni,I(df$new.cohort*df$eduni),
		df$married, I(df$new.cohort*df$married),
		df$roccupation.manual, I(df$new.cohort*df$roccupation.manual),
		df$house.manual, I(df$new.cohort*df$house.manual),
		df$Urban, I(df$new.cohort*df$Urban),
		df$rreligion, I(df$new.cohort*df$rreligion),
		df$church.attendance, I(df$new.cohort*df$church.attendance),
		df$unionm, I(df$new.cohort*df$unionm),
		df$voted.past, I(df$new.cohort*df$voted.past)
)


y<-df$vote


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Manifesto Benoit", "New.cohort*Manifesto",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "New.cohort*Log.Age",
			"Female", "New.cohort*Female",
			"Education", "New.cohort*Education",
			"Married", "New.cohort*Married",
			"Roccupation", "New.cohort*Roccupation",
			"House.Manual", "New.cohort*House.Manual",
			"Urban", "New.cohort*Urban",
			"Religion", "New.cohort*Religion",
			"Church.Attendance", "New.cohort*Church.Attendance",
			"Union", "New.cohort*Union",
			"Voted.past", "New.cohort*Voted.past"
			)
 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.TableA2.Col1.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.TableA2.Col1.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.TableA2.Col1.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.TableA2.Col1.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.TableA2.Col1.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.TableA2.Col1.MCMC.Imputed 5")
R.5<-Results$Beta

Results<-rbind(R.1,R.2,R.3,R.4,R.5)

#Display results
Estimates.TableA2.Col1.MCMC<-cbind(apply(Results,2,mean), HPDinterval(as.mcmc(Results), p=0.9))
colnames(Estimates.TableA2.Col1.MCMC)<-c("Estimate", "Lower90", "Upper90")

### Order the rows to make them appear as in Table A2, Col 1
Estimates.TableA2.Col1.MCMC<-Estimates.TableA2.Col1.MCMC[c(2:4,7:8,5:6,9:14,17:18, 15:16,19:34,1),]

# Display MCMC estimates
round(Estimates.TableA2.Col1.MCMC, digits=3)

save(Results, file="Fixed-effects MCMC estimates.TableA2.Col1")

rm(list=ls())

# Compute DIC
DIC<-c()
for (imp in 1:5) {

load(paste("Results.TableA2.Col1.MCMC.Imputed",imp))

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"vote", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))

X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation, df$fem.franchise, 
		df$log.age, I(df$new.cohort*df$log.age),
		df$female,I(df$new.cohort*df$female),
		df$eduni,I(df$new.cohort*df$eduni),
		df$married, I(df$new.cohort*df$married),
		df$roccupation.manual, I(df$new.cohort*df$roccupation.manual),
		df$house.manual, I(df$new.cohort*df$house.manual),
		df$Urban, I(df$new.cohort*df$Urban),
		df$rreligion, I(df$new.cohort*df$rreligion),
		df$church.attendance, I(df$new.cohort*df$church.attendance),
		df$unionm, I(df$new.cohort*df$unionm),
		df$voted.past, I(df$new.cohort*df$voted.past)
)


y<-df$vote


D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)


DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

rm(list=ls())

###
#TABLE A.2 - Column 2 (MCMC)
for (imp in 1:5) {
load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"vote", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))

# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1

X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation, df$fem.franchise, 
		df$log.age, I(df$new.cohort*df$log.age),
		df$female,I(df$new.cohort*df$female),
		df$eduni,I(df$new.cohort*df$eduni),
		df$married, I(df$new.cohort*df$married),
		df$roccupation.manual, I(df$new.cohort*df$roccupation.manual),
		df$house.manual, I(df$new.cohort*df$house.manual),
		df$Urban, I(df$new.cohort*df$Urban),
		df$rreligion, I(df$new.cohort*df$rreligion),
		df$church.attendance, I(df$new.cohort*df$church.attendance),
		df$unionm, I(df$new.cohort*df$unionm),
		df$voted.past, I(df$new.cohort*df$voted.past)
)


y<-df$vote


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party DIF", "New.cohort*Party DIF",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "New.cohort*Log.Age",
			"Female", "New.cohort*Female",
			"Education", "New.cohort*Education",
			"Married", "New.cohort*Married",
			"Roccupation", "New.cohort*Roccupation",
			"House.Manual", "New.cohort*House.Manual",
			"Urban", "New.cohort*Urban",
			"Religion", "New.cohort*Religion",
			"Church.Attendance", "New.cohort*Church.Attendance",
			"Union", "New.cohort*Union",
			"Voted.past", "New.cohort*Voted.past"
			)
 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.TableA2.Col2.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.TableA2.Col2.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.TableA2.Col2.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.TableA2.Col2.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.TableA2.Col2.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.TableA2.Col2.MCMC.Imputed 5")
R.5<-Results$Beta

Results<-rbind(R.1,R.2,R.3,R.4,R.5)

#Display results
Estimates.TableA2.Col2.MCMC<-cbind(apply(Results,2,mean), HPDinterval(as.mcmc(Results), p=0.9))
colnames(Estimates.TableA2.Col2.MCMC)<-c("Estimate", "Lower90", "Upper90")

### Order the rows to make them appear as in Table A2, Col 2
Estimates.TableA2.Col2.MCMC<-Estimates.TableA2.Col2.MCMC[c(2:4,7:8,5:6,9:14,17:18, 15:16,19:34,1),]

# Display MCMC estimates
round(Estimates.TableA2.Col2.MCMC, digits=3)


save(Results, file="Fixed-effects MCMC estimates.TableA2.Col2")

rm(list=ls())

# Compute DIC
DIC<-c()
for (imp in 1:5) {

load(paste("Results.TableA2.Col2.MCMC.Imputed",imp))

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"vote", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation, df$fem.franchise, 
		df$log.age, I(df$new.cohort*df$log.age),
		df$female,I(df$new.cohort*df$female),
		df$eduni,I(df$new.cohort*df$eduni),
		df$married, I(df$new.cohort*df$married),
		df$roccupation.manual, I(df$new.cohort*df$roccupation.manual),
		df$house.manual, I(df$new.cohort*df$house.manual),
		df$Urban, I(df$new.cohort*df$Urban),
		df$rreligion, I(df$new.cohort*df$rreligion),
		df$church.attendance, I(df$new.cohort*df$church.attendance),
		df$unionm, I(df$new.cohort*df$unionm),
		df$voted.past, I(df$new.cohort*df$voted.past)
)


y<-df$vote


D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)


DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

rm(list=ls())

##
#TABLE A.2 - Column 3 (MCMC)
for (imp in 1:5) {
load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"valid", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))

# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1

X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation, df$fem.franchise, 
		df$log.age, I(df$new.cohort*df$log.age),
		df$female,I(df$new.cohort*df$female),
		df$eduni,I(df$new.cohort*df$eduni),
		df$married, I(df$new.cohort*df$married),
		df$roccupation.manual, I(df$new.cohort*df$roccupation.manual),
		df$house.manual, I(df$new.cohort*df$house.manual),
		df$Urban, I(df$new.cohort*df$Urban),
		df$rreligion, I(df$new.cohort*df$rreligion),
		df$church.attendance, I(df$new.cohort*df$church.attendance),
		df$unionm, I(df$new.cohort*df$unionm),
		df$voted.past, I(df$new.cohort*df$voted.past)
)


y<-df$valid


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Manifesto Benoit", "New.cohort*Manifesto",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "New.cohort*Log.Age",
			"Female", "New.cohort*Female",
			"Education", "New.cohort*Education",
			"Married", "New.cohort*Married",
			"Roccupation", "New.cohort*Roccupation",
			"House.Manual", "New.cohort*House.Manual",
			"Urban", "New.cohort*Urban",
			"Religion", "New.cohort*Religion",
			"Church.Attendance", "New.cohort*Church.Attendance",
			"Union", "New.cohort*Union",
			"Voted.past", "New.cohort*Voted.past"
			)
 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.TableA2.Col3.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.TableA2.Col3.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.TableA2.Col3.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.TableA2.Col3.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.TableA2.Col3.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.TableA2.Col3.MCMC.Imputed 5")
R.5<-Results$Beta

Results<-rbind(R.1,R.2,R.3,R.4,R.5)

#Display results
Estimates.TableA2.Col3.MCMC<-cbind(apply(Results,2,mean), HPDinterval(as.mcmc(Results), p=0.9))
colnames(Estimates.TableA2.Col3.MCMC)<-c("Estimate", "Lower90", "Upper90")

### Order the rows to make them appear as in Table A2, Col 3
Estimates.TableA2.Col3.MCMC<-Estimates.TableA2.Col3.MCMC[c(2:4,7:8,5:6,9:14,17:18, 15:16,19:34,1),]

# Display MCMC estimates
round(Estimates.TableA2.Col3.MCMC, digits=3)

save(Results, file="Fixed-effects MCMC estimates.TableA2.Col3")

rm(list=ls())

# Compute DIC
DIC<-c()
for (imp in 1:5) {

load(paste("Results.TableA2.Col3.MCMC.Imputed",imp))

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"valid", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))

X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation, df$fem.franchise, 
		df$log.age, I(df$new.cohort*df$log.age),
		df$female,I(df$new.cohort*df$female),
		df$eduni,I(df$new.cohort*df$eduni),
		df$married, I(df$new.cohort*df$married),
		df$roccupation.manual, I(df$new.cohort*df$roccupation.manual),
		df$house.manual, I(df$new.cohort*df$house.manual),
		df$Urban, I(df$new.cohort*df$Urban),
		df$rreligion, I(df$new.cohort*df$rreligion),
		df$church.attendance, I(df$new.cohort*df$church.attendance),
		df$unionm, I(df$new.cohort*df$unionm),
		df$voted.past, I(df$new.cohort*df$voted.past)
)


y<-df$valid

D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)


DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

rm(list=ls())

#TABLE A.2 - Column 4 (MCMC)
for (imp in 1:5) {
load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"valid", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))

# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1

X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation, df$fem.franchise, 
		df$log.age, I(df$new.cohort*df$log.age),
		df$female,I(df$new.cohort*df$female),
		df$eduni,I(df$new.cohort*df$eduni),
		df$married, I(df$new.cohort*df$married),
		df$roccupation.manual, I(df$new.cohort*df$roccupation.manual),
		df$house.manual, I(df$new.cohort*df$house.manual),
		df$Urban, I(df$new.cohort*df$Urban),
		df$rreligion, I(df$new.cohort*df$rreligion),
		df$church.attendance, I(df$new.cohort*df$church.attendance),
		df$unionm, I(df$new.cohort*df$unionm),
		df$voted.past, I(df$new.cohort*df$voted.past)
)


y<-df$valid


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party DIF", "New.cohort*Party DIF",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "New.cohort*Log.Age",
			"Female", "New.cohort*Female",
			"Education", "New.cohort*Education",
			"Married", "New.cohort*Married",
			"Roccupation", "New.cohort*Roccupation",
			"House.Manual", "New.cohort*House.Manual",
			"Urban", "New.cohort*Urban",
			"Religion", "New.cohort*Religion",
			"Church.Attendance", "New.cohort*Church.Attendance",
			"Union", "New.cohort*Union",
			"Voted.past", "New.cohort*Voted.past"
			)
 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.TableA2.Col4.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.TableA2.Col4.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.TableA2.Col4.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.TableA2.Col4.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.TableA2.Col4.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.TableA2.Col4.MCMC.Imputed 5")
R.5<-Results$Beta

Results<-rbind(R.1,R.2,R.3,R.4,R.5)

#Display results
Estimates.TableA2.Col4.MCMC<-cbind(apply(Results,2,mean), HPDinterval(as.mcmc(Results), p=0.9))
colnames(Estimates.TableA2.Col4.MCMC)<-c("Estimate", "Lower90", "Upper90")

### Order the rows to make them appear as in Table A2, Col 4
Estimates.TableA2.Col4.MCMC<-Estimates.TableA2.Col4.MCMC[c(2:4,7:8,5:6,9:14,17:18, 15:16,19:34,1),]

# Display MCMC estimates
round(Estimates.TableA2.Col4.MCMC, digits=3)

save(Results, file="Fixed-effects MCMC estimates.TableA2.Col4")

rm(list=ls())

# Compute DIC
DIC<-c()
for (imp in 1:5) {

load(paste("Results.TableA2.Col4.MCMC.Imputed",imp))

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"valid", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))

X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation, df$fem.franchise, 
		df$log.age, I(df$new.cohort*df$log.age),
		df$female,I(df$new.cohort*df$female),
		df$eduni,I(df$new.cohort*df$eduni),
		df$married, I(df$new.cohort*df$married),
		df$roccupation.manual, I(df$new.cohort*df$roccupation.manual),
		df$house.manual, I(df$new.cohort*df$house.manual),
		df$Urban, I(df$new.cohort*df$Urban),
		df$rreligion, I(df$new.cohort*df$rreligion),
		df$church.attendance, I(df$new.cohort*df$church.attendance),
		df$unionm, I(df$new.cohort*df$unionm),
		df$voted.past, I(df$new.cohort*df$voted.past)
)


y<-df$valid


D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]))
)


DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)

rm(list=ls())


############## Now repeat estimation using likelihood-based methods ##########
# Table A.2 - Column 1 (Likelihood-based)
Result<-list()
for (j in 1:5) {
load(paste("df.imputed",j)) 

result<-glmer(vote~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			logrile+I(new.cohort*logrile)+
			young.initiation+fem.franchise+
			log.age+I(new.cohort*log.age)+
			female+I(new.cohort*female)+
			eduni+I(new.cohort*eduni)+
			married+I(new.cohort*married)+
			roccupation.manual+I(new.cohort*roccupation.manual)+
			house.manual+I(new.cohort*house.manual)+
			Urban+I(new.cohort*Urban)+
			rreligion+I(new.cohort*rreligion)+
			church.attendance+I(new.cohort*church.attendance)+
			unionm+I(new.cohort*unionm)+
			voted.past+I(new.cohort*voted.past)+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 

Result[[j]]<-result

print(j)
}

## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5


Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.TableA2.Col1.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.TableA2.Col1.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.TableA2.Col1.ML

# Display significance "stars"
Result<-Results.TableA2.Col1.ML

Significance.TableA2.Col1.ML<-as.matrix(c(ifelse(rowSums(sign(Result[,7:8]))!=0,"***",
ifelse(rowSums(sign(Result[,5:6]))!=0,"**",
ifelse(rowSums(sign(Result[,3:4]))!=0,"*"," ")))))
colnames(Significance.TableA2.Col1.ML)<-c("Asterisks")

### Order the rows to make them appear as in Table A2, Col 1
Significance.TableA2.Col1.ML<-as.matrix(Significance.TableA2.Col1.ML[c(2:4,7:8,5:6,9:14,17:18, 15:16,19:34,1),])

Significance.TableA2.Col1.ML


write.csv(Results.TableA2.Col1.ML, file="Results.TableA2.Col1.ML.csv")
rm(list=ls())


# Table A.2 - Column 2 (Likelihood-based)
Result<-list()
for (j in 1:5) {
load(paste("df.imputed",j)) 

result<-glmer(vote~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			log.age+I(new.cohort*log.age)+
			female+I(new.cohort*female)+
			eduni+I(new.cohort*eduni)+
			married+I(new.cohort*married)+
			roccupation.manual+I(new.cohort*roccupation.manual)+
			house.manual+I(new.cohort*house.manual)+
			Urban+I(new.cohort*Urban)+
			rreligion+I(new.cohort*rreligion)+
			church.attendance+I(new.cohort*church.attendance)+
			unionm+I(new.cohort*unionm)+
			voted.past+I(new.cohort*voted.past)+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 

Result[[j]]<-result

print(j)
}

## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5

Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.TableA2.Col2.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.TableA2.Col2.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")


# Display results
Results.TableA2.Col2.ML

# Display significance "stars"
Results<-Results.TableA2.Col2.ML

Significance.TableA2.Col2.ML<-as.matrix(
c(ifelse(rowSums(sign(Result[,7:8]))!=0,"***",
ifelse(rowSums(sign(Result[,5:6]))!=0,"**",
ifelse(rowSums(sign(Result[,3:4]))!=0,"*"," ")))))
colnames(Significance.TableA2.Col2.ML)<-c("Asterisks")

### Order the rows to make them appear as in Table A2, Col 2
Significance.TableA2.Col2.ML<-as.matrix(Significance.TableA2.Col2.ML[c(2:4,7:8,5:6,9:14,17:18, 15:16,19:34,1),])


Significance.TableA2.Col2.ML


write.csv(Results.TableA2.Col2.ML, file="Results.TableA2.Col2.ML.csv")
rm(list=ls())


# Table A.2 - Column 3 (Likelihood-based)
Result<-list()
for (j in 1:5) {
load(paste("df.imputed",j)) 

result<-glmer(valid~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			logrile+I(new.cohort*logrile)+
			young.initiation+fem.franchise+
			log.age+I(new.cohort*log.age)+
			female+I(new.cohort*female)+
			eduni+I(new.cohort*eduni)+
			married+I(new.cohort*married)+
			roccupation.manual+I(new.cohort*roccupation.manual)+
			house.manual+I(new.cohort*house.manual)+
			Urban+I(new.cohort*Urban)+
			rreligion+I(new.cohort*rreligion)+
			church.attendance+I(new.cohort*church.attendance)+
			unionm+I(new.cohort*unionm)+
			voted.past+I(new.cohort*voted.past)+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 

Result[[j]]<-result

print(j)
}
 
## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5


Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.TableA2.Col3.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.TableA2.Col3.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.TableA2.Col3.ML

# Display significance "stars"
Result<-Results.TableA2.Col3.ML

Significance.TableA2.Col3.ML<-as.matrix(
c(ifelse(rowSums(sign(Result[,7:8]))!=0,"***",
ifelse(rowSums(sign(Result[,5:6]))!=0,"**",
ifelse(rowSums(sign(Result[,3:4]))!=0,"*"," ")))))
colnames(Significance.TableA2.Col3.ML)<-c("Asterisks")

### Order the rows to make them appear as in Table A2, Col 3
Significance.TableA2.Col3.ML<-as.matrix(Significance.TableA2.Col3.ML[c(2:4,7:8,5:6,9:14,17:18, 15:16,19:34,1),])

Significance.TableA2.Col3.ML

write.csv(Results.TableA2.Col3.ML, file="Results.TableA2.Col3.ML.csv")
rm(list=ls())



## Table A.2 - Column 4 (Likelihood-based)
Result<-list()
for (j in 1:5) {
load(paste("df.imputed",j)) 

result<-glmer(valid~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			log.age+I(new.cohort*log.age)+
			female+I(new.cohort*female)+
			eduni+I(new.cohort*eduni)+
			married+I(new.cohort*married)+
			roccupation.manual+I(new.cohort*roccupation.manual)+
			house.manual+I(new.cohort*house.manual)+
			Urban+I(new.cohort*Urban)+
			rreligion+I(new.cohort*rreligion)+
			church.attendance+I(new.cohort*church.attendance)+
			unionm+I(new.cohort*unionm)+
			voted.past+I(new.cohort*voted.past)+
			(1|constit)+(1|electn),
				data=df, family = binomial("probit")) 

Result[[j]]<-result

print(j)
}

## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5


Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.TableA2.Col4.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.TableA2.Col4.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")


# Display results
Results.TableA2.Col4.ML

# Display significance "stars"
Result<-Results.TableA2.Col4.ML

Significance.TableA2.Col4.ML<-as.matrix(
c(ifelse(rowSums(sign(Result[,7:8]))!=0,"***",
ifelse(rowSums(sign(Result[,5:6]))!=0,"**",
ifelse(rowSums(sign(Result[,3:4]))!=0,"*"," ")))))
colnames(Significance.TableA2.Col4.ML)<-c("Asterisks")

### Order the rows to make them appear as in Table A2, Col 4
Significance.TableA2.Col4.ML<-as.matrix(Significance.TableA2.Col4.ML[c(2:4,7:8,5:6,9:14,17:18, 15:16,19:34,1),])

Significance.TableA2.Col4.ML

write.csv(Results.TableA2.Col4.ML, file="Results.TableA2.Col4.ML.csv")
rm(list=ls())

################################ FIGURE A.2 ###########################################
### Need to compute average predictive comparisons first before
### plotting

## MARGINAL EFFECTS FOR FIGURE A.2 - REPORTED VOTE
Pastvote<-c()
Church<-c()
Religion<-c()
Urban<-c()
Union<-c()
Manual.household<-c()
Manual.worker<-c()
Married<-c()
Education<-c()
Female<-c()
Log.age<-c()
Late.female.suffrage<-c()
Young.initiation<-c()

for (imp in 1:5) {

load(paste("Results.Table2.Col3.MCMC.Imputed",imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"vote", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))



X<-cbind(1, 
		df$new.cohort,
		df$lag_seatmg, I(df$new.cohort*df$lag_seatmg),
		df$last_polls, I(df$new.cohort*df$last_polls),
		df$lag_constit, I(df$new.cohort*df$lag_constit),
		df$partydf, I(df$new.cohort*df$partydf),
		df$young.initiation, df$fem.franchise,
		df$log.age, df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past
 		)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))

# 1) MARGINAL EFFECT FOR YOUNG INITIATION

X.original<-X
X.original[,11]<-0

X.prime<-X.original
X.prime[,11]<-1

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)

Young.initiation<-c(Young.initiation, prime-original)


# 2) MARGINAL EFFECT FOR LATE FEMALE SUFFRAGE
X.original<-X
X.original[,12]<-0

X.prime<-X.original
X.prime[,12]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Late.female.suffrage<-c(Late.female.suffrage, prime-original)

# 3) MARGINAL EFFECT FOR LOG.AGE
X.original<-X

X.prime<-X.original
X.prime[,13]<-df$log.age+1



original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)


Log.age<-c(Log.age, prime-original)


# 4) MARGINAL EFFECT FOR FEMALE
X.original<-X
X.original[,14]<-0

X.prime<-X.original
X.prime[,14]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Female<-c(Female, prime-original)


# 5) MARGINAL EFFECT FOR EDUCATION
X.original<-X
X.original[,15]<-0

X.prime<-X.original
X.prime[,15]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Education<-c(Education,prime-original)


# 6) MARGINAL EFFECT FOR MARRIED
X.original<-X
X.original[,16]<-0

X.prime<-X.original
X.prime[,16]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Married<-c(Married, prime-original)


# 7) MARGINAL EFFECT FOR MANUAL WORKER
X.original<-X
X.original[,17]<-0

X.prime<-X.original
X.prime[,17]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Manual.worker<-c(Manual.worker, prime-original)

# 8) MARGINAL EFFECT FOR MANUAL HOUSEHOLD
X.original<-X
X.original[,18]<-0

X.prime<-X.original
X.prime[,18]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Manual.household<-c(Manual.household, prime-original)

# 9) MARGINAL EFFECT FOR URBAN
X.original<-X
X.original[,19]<-0

X.prime<-X.original
X.prime[,19]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Urban<-c(Urban, prime-original)


# 10) MARGINAL EFFECT FOR RELIGION
X.original<-X
X.original[,20]<-0

X.prime<-X.original
X.prime[,20]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Religion<-c(Religion, prime-original)

# 11) MARGINAL EFFECT FOR CHURCH ATTENDANCE
X.original<-X
X.original[,21]<-0

X.prime<-X.original
X.prime[,21]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Church<-c(Church, prime-original)

# 12) MARGINAL EFFECT FOR UNION
X.original<-X
X.original[,22]<-0

X.prime<-X.original
X.prime[,22]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Union<-c(Union, prime-original)

# 13) MARGINAL EFFECT FOR VOTED PREVIOUS ELECTION
X.original<-X
X.original[,23]<-0

X.prime<-X.original
X.prime[,23]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Pastvote<-c(Pastvote, prime-original)

print(imp)
}


Estimates<-cbind(Young.initiation, Late.female.suffrage,
	   Log.age, Female,
	   Education, Married,
		Manual.worker, Manual.household,
		Urban, Union, Religion, Church,
		Pastvote)


Mean.effects<-apply(Estimates,2,mean)*100

CI<-HPDinterval(as.mcmc(Estimates), p=0.9)*100


# Mean and 90% CI
Reported.summary<-cbind(Mean.effects, CI)
Reported.summary<-cbind(c("Young Initiation", "Late Female Suffrage", 
				"(Log) Age", "Female","Education", 
				"Married", "Occupation (respondent)",
				"Household Occupation", 
				"Urban", "Union Member", 
				"Religion",  "Church Attendance", 
				"Voted Previous Election"), "Self-reported vote", Reported.summary)
colnames(Reported.summary)<-c("Variable", "Vote", "Mean", "lower", "upper")


## MARGINAL EFFECTS FOR FIGURE A.2 - VALIDATED VOTE
Pastvote<-c()
Church<-c()
Religion<-c()
Urban<-c()
Union<-c()
Manual.household<-c()
Manual.worker<-c()
Married<-c()
Education<-c()
Female<-c()
Log.age<-c()
Late.female.suffrage<-c()
Young.initiation<-c()

for (imp in 1:5) {

load(paste("Results.Table2.Col6.MCMC.Imputed",imp))

load(paste("df.imputed",imp))

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"valid", "electn", "constit"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))



X<-cbind(1, 
		df$new.cohort,
		df$lag_seatmg, I(df$new.cohort*df$lag_seatmg),
		df$last_polls, I(df$new.cohort*df$last_polls),
		df$lag_constit, I(df$new.cohort*df$lag_constit),
		df$partydf, I(df$new.cohort*df$partydf),
		df$young.initiation, df$fem.franchise,
		df$log.age, df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past
 		)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))

# 1) MARGINAL EFFECT FOR YOUNG INITIATION

X.original<-X
X.original[,11]<-0

X.prime<-X.original
X.prime[,11]<-1

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)

Young.initiation<-c(Young.initiation, prime-original)


# 2) MARGINAL EFFECT FOR LATE FEMALE SUFFRAGE
X.original<-X
X.original[,12]<-0

X.prime<-X.original
X.prime[,12]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Late.female.suffrage<-c(Late.female.suffrage, prime-original)

# 3) MARGINAL EFFECT FOR LOG.AGE
X.original<-X

X.prime<-X.original
X.prime[,13]<-df$log.age+1



original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)


Log.age<-c(Log.age, prime-original)


# 4) MARGINAL EFFECT FOR FEMALE
X.original<-X
X.original[,14]<-0

X.prime<-X.original
X.prime[,14]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Female<-c(Female, prime-original)


# 5) MARGINAL EFFECT FOR EDUCATION
X.original<-X
X.original[,15]<-0

X.prime<-X.original
X.prime[,15]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Education<-c(Education,prime-original)


# 6) MARGINAL EFFECT FOR MARRIED
X.original<-X
X.original[,16]<-0

X.prime<-X.original
X.prime[,16]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Married<-c(Married, prime-original)


# 7) MARGINAL EFFECT FOR MANUAL WORKER
X.original<-X
X.original[,17]<-0

X.prime<-X.original
X.prime[,17]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Manual.worker<-c(Manual.worker, prime-original)

# 8) MARGINAL EFFECT FOR MANUAL HOUSEHOLD
X.original<-X
X.original[,18]<-0

X.prime<-X.original
X.prime[,18]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Manual.household<-c(Manual.household, prime-original)

# 9) MARGINAL EFFECT FOR URBAN
X.original<-X
X.original[,19]<-0

X.prime<-X.original
X.prime[,19]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Urban<-c(Urban, prime-original)


# 10) MARGINAL EFFECT FOR RELIGION
X.original<-X
X.original[,20]<-0

X.prime<-X.original
X.prime[,20]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Religion<-c(Religion, prime-original)

# 11) MARGINAL EFFECT FOR CHURCH ATTENDANCE
X.original<-X
X.original[,21]<-0

X.prime<-X.original
X.prime[,21]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Church<-c(Church, prime-original)

# 12) MARGINAL EFFECT FOR UNION
X.original<-X
X.original[,22]<-0

X.prime<-X.original
X.prime[,22]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Union<-c(Union, prime-original)

# 13) MARGINAL EFFECT FOR VOTED PREVIOUS ELECTION
X.original<-X
X.original[,23]<-0

X.prime<-X.original
X.prime[,23]<-1


original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Pastvote<-c(Pastvote, prime-original)

print(imp)
}


Estimates<-cbind(Young.initiation, Late.female.suffrage,
	   Log.age, Female,
	   Education, Married,
		Manual.worker, Manual.household,
		Urban, Union, Religion, Church,
		Pastvote)


Mean.effects<-apply(Estimates,2,mean)*100

CI<-HPDinterval(as.mcmc(Estimates), p=0.9)*100


# Mean and 90% CI
Validated.summary<-cbind(Mean.effects, CI)
Validated.summary<-cbind(c("Young Initiation", "Late Female Suffrage", 
				"(Log) Age", "Female","Education", 
				"Married", "Occupation (respondent)",
				"Household Occupation", 
				"Urban", "Union Member", 
				"Religion",  "Church Attendance", 
				"Voted Previous Election"), "Validated vote", Validated.summary)
colnames(Validated.summary)<-c("Variable", "Vote", "Mean", "lower", "upper")

Marginal.effects.FigureA2.MCMC<-rbind(Reported.summary,
							Validated.summary)
write.csv(Marginal.effects.FigureA2.MCMC, "Marginal.effects.FigureA2.MCMC.csv")

rm(list=ls())

df<-read.csv("Marginal.effects.FigureA2.MCMC.csv")

df$Variable<-factor(df$Variable, 
levels=rev(c("Young Initiation", "Late Female Suffrage",
		"(Log) Age", "Education", "Female",	"Married",
		"Occupation (respondent)", "Household Occupation",
		"Urban", "Religion", "Church Attendance", "Union Member",
		"Voted Previous Election") )) 

p <- ggplot(df, aes(y= Variable, x=Mean))+
	geom_point(size=3) + 
	geom_errorbarh(aes(xmax=upper, xmin=lower),  height=0.2)+
	 xlab("Marginal effect on turnout (%)")+ylab("")+
	 scale_colour_manual(values=c("black", "gray60"))+
	 facet_grid(~Vote)+scale_x_continuous(breaks=c(-5, 0, 5, 10,15, 20,25))+
	geom_vline(xintercept = 0, linetype = "longdash", col="gray20")

p+theme_bw()+theme(legend.position = "bottom")+theme(legend.title=element_blank())

rm(list=ls())

################################# FIGURE A.3 ##################################
# Must generate parameter estimates and compute average predictive 
### comparisons first before plotting

# Figure A.3 - Reported
load("completecase.reported")

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", "initial.seat.margin",
		"vote", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, df$initial.seat.margin
)

y<-df$vote


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party DIF", "New.cohort*Party DIF",
			"Young Initiation", "Fem. Franchising",
			"Initial.Seat.Margin"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file="Results.FigureA3.Reported.MCMC")


Beta<-Results$Beta

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)


save(Beta, file="Fixed-effects MCMC estimates.FigureA3.Reported")
rm(list=ls())


# Figure A.3 - Validated
load("completecase.validated")

df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", "initial.seat.margin",
		"valid", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, df$initial.seat.margin
)

y<-df$valid


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party DIF", "New.cohort*Party DIF",
			"Young Initiation", "Fem. Franchising",
			"Initial.Seat.Margin"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file="Results.FigureA3.Validated.MCMC")


Beta<-Results$Beta

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)


save(Beta, file="Fixed-effects MCMC estimates.FigureA3.Validated")
rm(list=ls())


## ## MARGINAL EFFECTS FOR FIGURE A.3 - REPORTED VOTE 
load("completecase.reported")
load("Results.FigureA3.Reported.MCMC")

X<-cbind(1, 
		df$new.cohort,
		df$lag_seatmg, I(df$new.cohort*df$lag_seatmg),
		df$last_polls, I(df$new.cohort*df$last_polls),
		df$lag_constit, I(df$new.cohort*df$lag_constit),
		df$partydf, I(df$new.cohort*df$partydf),
		df$young.initiation, df$fem.franchise,
		 df$initial.seat.margin
 		)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


### 1) MARGINAL EFFECT FOR LAG SEATMAG 

# 1.1 Established cohorts
X.original<-X
X.original[,4]<-0
X.original[,6]<-0
X.original[,8]<-0
X.original[,10]<-0

X.prime<-X.original
X.prime[,3]<-df$lag_seatmg+sd(unique(df$lag_seatmg))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Lag.seatmag.established<-(prime-original)*100


# 1.2 New cohorts
X.original<-X
X.original[,2]<-1
X.original[,4]<-df$lag_seatmg
X.original[,6]<-df$last_polls
X.original[,8]<-df$lag_constit
X.original[,10]<-df$partydf

X.prime<-X.original
X.prime[,3]<-df$lag_seatmg+sd(unique(df$lag_seatmg))
X.prime[,4]<-df$lag_seatmg+sd(unique(df$lag_seatmg))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Lag.seatmag.new<-(prime-original)*100


## 2) MARGINAL EFFECT FOR LAST POLLS

# 2.1 Established cohorts
X.original<-X
X.original[,4]<-0
X.original[,6]<-0
X.original[,8]<-0
X.original[,10]<-0

X.prime<-X.original
X.prime[,5]<-log(df$excls+sd(unique(df$excls)))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Last.polls.established<-(prime-original)*100

# 2.2 New cohorts
X.original<-X
X.original[,2]<-1
X.original[,4]<-df$lag_seatmg
X.original[,6]<-df$last_polls
X.original[,8]<-df$lag_constit
X.original[,10]<-df$partydf

X.prime<-X.original
X.prime[,5]<-log(df$excls+sd(unique(df$excls)))
X.prime[,6]<-log(df$excls+sd(unique(df$excls)))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Last.polls.new<-(prime-original)*100

## 3) MARGINAL EFFECT FOR LAG CONSTIT

# 3.1 Established cohorts
X.original<-X
X.original[,4]<-0
X.original[,6]<-0
X.original[,8]<-0
X.original[,10]<-0

X.prime<-X.original
X.prime[,7]<-df$lag_constit+sd(unique(df$lag_constit))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Lag.constit.established<-(prime-original)*100

# 3.2 New cohorts
X.original<-X
X.original[,2]<-1
X.original[,4]<-df$lag_seatmg
X.original[,6]<-df$last_polls
X.original[,8]<-df$lag_constit
X.original[,10]<-df$partydf

X.prime<-X.original
X.prime[,7]<-df$lag_constit+sd(unique(df$lag_constit))
X.prime[,8]<-df$lag_constit+sd(unique(df$lag_constit))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Lag.constit.new<-(prime-original)*100

## 4) MARGINAL EFFECT FOR PERCEIVED PARTY DIFFERENCES

# 4.1 Established cohorts
X.original<-X
X.original[,4]<-0
X.original[,6]<-0
X.original[,8]<-0
X.original[,9]<-min(df$partydf)
X.original[,10]<-0

X.prime<-X.original
X.prime[,9]<-max(df$partydf)

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Partydf.established<-(prime-original)*100

# 4.2 New cohorts
X.original<-X
X.original[,2]<-1
X.original[,4]<-df$lag_seatmg
X.original[,6]<-df$last_polls
X.original[,8]<-df$lag_constit
X.original[,9]<-min(df$partydf)
X.original[,10]<-min(df$partydf)

X.prime<-X.original
X.prime[,9]<-max(df$partydf)
X.prime[,10]<-max(df$partydf)

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Partydf.new<-(prime-original)*100

## 5) MARGINAL EFFECT FOR INITIAL SEAT MARGIN
X.original<-X
X.prime<-X.original
X.prime[,13]<-df$initial.seat.margin+sd(unique(df$initial.seat.margin))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Initial.seat.margin<-(prime-original)*100

Estimates<-cbind(Lag.seatmag.established, Lag.seatmag.new,
		Lag.constit.established, Lag.constit.new,
		Last.polls.established, Last.polls.new,
		Partydf.established,Partydf.new,
		Initial.seat.margin)

Mean.effects<-apply(Estimates,2,mean)

CI<-HPDinterval(as.mcmc(Estimates), p=0.9)

# Mean and 90% CI
Reported.summary<-cbind(Mean.effects, CI)
Reported.summary<-cbind(c("lag_seatmg - established cohorts",
		 "lag_seatmg - new cohorts",
	"lag_constit - established cohorts", 
	"lag_constit - new cohorts",
	"last_polls - established cohorts", 
	"last_polls - new cohorts",
	"partydf - established cohorts", 
	"partydf - new cohorts",
	"initial seatmag"),"Self-reported vote", Reported.summary)
colnames(Reported.summary)<-c("Variable", "Vote", "Mean", "lower", "upper")
	


## ## MARGINAL EFFECTS FOR FIGURE A.3 - VALIDATED VOTE 
load("completecase.validated")
load("Results.FigureA3.Validated.MCMC")

X<-cbind(1, 
		df$new.cohort,
		df$lag_seatmg, I(df$new.cohort*df$lag_seatmg),
		df$last_polls, I(df$new.cohort*df$last_polls),
		df$lag_constit, I(df$new.cohort*df$lag_constit),
		df$partydf, I(df$new.cohort*df$partydf),
		df$young.initiation, df$fem.franchise,
		 df$initial.seat.margin
 		)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


### 1) MARGINAL EFFECT FOR LAG SEATMAG 

# 1.1 Established cohorts
X.original<-X
X.original[,4]<-0
X.original[,6]<-0
X.original[,8]<-0
X.original[,10]<-0

X.prime<-X.original
X.prime[,3]<-df$lag_seatmg+sd(unique(df$lag_seatmg))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Lag.seatmag.established<-(prime-original)*100


# 1.2 New cohorts
X.original<-X
X.original[,2]<-1
X.original[,4]<-df$lag_seatmg
X.original[,6]<-df$last_polls
X.original[,8]<-df$lag_constit
X.original[,10]<-df$partydf

X.prime<-X.original
X.prime[,3]<-df$lag_seatmg+sd(unique(df$lag_seatmg))
X.prime[,4]<-df$lag_seatmg+sd(unique(df$lag_seatmg))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Lag.seatmag.new<-(prime-original)*100


## 2) MARGINAL EFFECT FOR LAST POLLS

# 2.1 Established cohorts
X.original<-X
X.original[,4]<-0
X.original[,6]<-0
X.original[,8]<-0
X.original[,10]<-0

X.prime<-X.original
X.prime[,5]<-log(df$excls+sd(unique(df$excls)))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Last.polls.established<-(prime-original)*100

# 2.2 New cohorts
X.original<-X
X.original[,2]<-1
X.original[,4]<-df$lag_seatmg
X.original[,6]<-df$last_polls
X.original[,8]<-df$lag_constit
X.original[,10]<-df$partydf

X.prime<-X.original
X.prime[,5]<-log(df$excls+sd(unique(df$excls)))
X.prime[,6]<-log(df$excls+sd(unique(df$excls)))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Last.polls.new<-(prime-original)*100

## 3) MARGINAL EFFECT FOR LAG CONSTIT

# 3.1 Established cohorts
X.original<-X
X.original[,4]<-0
X.original[,6]<-0
X.original[,8]<-0
X.original[,10]<-0

X.prime<-X.original
X.prime[,7]<-df$lag_constit+sd(unique(df$lag_constit))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Lag.constit.established<-(prime-original)*100

# 3.2 New cohorts
X.original<-X
X.original[,2]<-1
X.original[,4]<-df$lag_seatmg
X.original[,6]<-df$last_polls
X.original[,8]<-df$lag_constit
X.original[,10]<-df$partydf

X.prime<-X.original
X.prime[,7]<-df$lag_constit+sd(unique(df$lag_constit))
X.prime[,8]<-df$lag_constit+sd(unique(df$lag_constit))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Lag.constit.new<-(prime-original)*100

## 4) MARGINAL EFFECT FOR PERCEIVED PARTY DIFFERENCES

# 4.1 Established cohorts
X.original<-X
X.original[,4]<-0
X.original[,6]<-0
X.original[,8]<-0
X.original[,9]<-min(df$partydf)
X.original[,10]<-0

X.prime<-X.original
X.prime[,9]<-max(df$partydf)

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Partydf.established<-(prime-original)*100

# 4.2 New cohorts
X.original<-X
X.original[,2]<-1
X.original[,4]<-df$lag_seatmg
X.original[,6]<-df$last_polls
X.original[,8]<-df$lag_constit
X.original[,9]<-min(df$partydf)
X.original[,10]<-min(df$partydf)

X.prime<-X.original
X.prime[,9]<-max(df$partydf)
X.prime[,10]<-max(df$partydf)

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Partydf.new<-(prime-original)*100

## 5) MARGINAL EFFECT FOR INITIAL SEAT MARGIN
X.original<-X
X.prime<-X.original
X.prime[,13]<-df$initial.seat.margin+sd(unique(df$initial.seat.margin))

original<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.original%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 
)
 
prime<-sapply(1:dim(Results$Beta)[1],
	function(s) mean(pnorm(X.prime%*%Results$Beta[s,]+
Results$B.area[s,Area]+Results$B.election[s,Election])) 

)

Initial.seat.margin<-(prime-original)*100

Estimates<-cbind(Lag.seatmag.established, Lag.seatmag.new,
		Lag.constit.established, Lag.constit.new,
		Last.polls.established, Last.polls.new,
		Partydf.established,Partydf.new,
		Initial.seat.margin)

Mean.effects<-apply(Estimates,2,mean)

CI<-HPDinterval(as.mcmc(Estimates), p=0.9)

# Mean and 90% CI
Validated.summary<-cbind(Mean.effects, CI)
Validated.summary<-cbind(c("lag_seatmg - established cohorts",
		 "lag_seatmg - new cohorts",
	"lag_constit - established cohorts", 
	"lag_constit - new cohorts",
	"last_polls - established cohorts", 
	"last_polls - new cohorts",
	"partydf - established cohorts", 
	"partydf - new cohorts",
	"initial seatmag"),"Validated vote", Validated.summary)
colnames(Validated.summary)<-c("Variable", "Vote", "Mean", "lower", "upper")


Marginal.effects.FigureA3.MCMC<-rbind(Reported.summary,
							Validated.summary)
write.csv(Marginal.effects.FigureA3.MCMC, "Marginal.effects.FigureA3.MCMC.csv")
rm(list=ls())

df<-read.csv("Marginal.effects.FigureA3.MCMC.csv")

df$Variable<-factor(df$Variable, 
levels=rev(c( "lag_seatmg - new cohorts", "lag_seatmg - established cohorts",
		"last_polls - new cohorts", "last_polls - established cohorts",
		"lag_constit - new cohorts", "lag_constit - established cohorts",
		"partydf - new cohorts", "partydf - established cohorts",
		"initial seatmag")),
labels = rev(c("Lagged Seat Margin - New cohorts", "Lagged Seat Margin - Established cohorts",
		"Last Polls - New cohorts", "Last Polls - Established cohorts",
		"Lagged Constituency Vote Margin - New Cohorts", 
		"Lagged Constituency Vote Margin - Established Cohorts",
		"Perceived Party Differences - New Cohorts", 
		"Perceived Party Differences - Established Cohorts",
		"Initial Seat Margin")))


dev.new(width=15, height=10)
p <- ggplot(df, aes(y= Variable, x=Mean))+
	geom_point() + 
	geom_errorbarh(aes(xmax=upper, xmin=lower),height=0.2)+
	 xlab("Marginal effect on turnout (%)")+ylab("")+
	 scale_colour_manual(values=c("black", "gray60"))+
	 facet_grid(~Vote)+scale_x_continuous(breaks=c(-5, 0, 5, 10,15, 20, 25))+
	geom_vline(xintercept = 0.0, size=0.5, linetype = "longdash", colour="gray20")

p+theme_bw()+theme(legend.position = "bottom")+
	theme(axis.text=element_text(size=12), legend.title=element_blank())+theme(strip.text=element_text(size=12))

rm(list=ls())


############################### FIGURE A.4 ###################################
# Must generate parameter estimates before plotting

#### REPORTED VOTE
#Initial constituency margin
for (imp in 1:5) {
load(paste("df.imputed.initialcompetition",imp))
df<-subset(df, nomove==1, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age", "female", "eduni", "married",
			"roccupation.manual", "house.manual",
			"Urban", "rreligion" , "church.attendance",
			"unionm", "voted.past",
			"initial.constituency.margin",
		"vote", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age, df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$union, df$voted.past, df$initial.constituency.margin
)

y<-df$vote

#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party DIF", "New.cohort*Party DIF",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past", "Initial.Constituency.Vote.Margin"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.FigureA4.InitialConstituency.Reported.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.FigureA4.InitialConstituency.Reported.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.FigureA4.InitialConstituency.Reported.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.FigureA4.InitialConstituency.Reported.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.FigureA4.InitialConstituency.Reported.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.FigureA4.InitialConstituency.Reported.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.FigureA4.InitialConstituency.Reported")


##
#Initial Manifesto Differences
for (imp in 1:5) {
load(paste("df.imputed.initialcompetition",imp))
df<-subset(df, first.election>=1945, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise", 
		"log.age", "female", "eduni", "married",
			"roccupation.manual", "house.manual",
			"Urban", "rreligion" , "church.attendance",
			"unionm", "voted.past",
			"initial.logrile",
		"vote", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age, df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$union, df$voted.past, df$initial.logrile
)

y<-df$vote

#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Manifesto Differences", "New.cohort*Manifesto",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past", "Initial.Manifesto.Differences"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.FigureA4.InitialManifesto.Reported.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.FigureA4.InitialManifesto.Reported.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.FigureA4.InitialManifesto.Reported.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.FigureA4.InitialManifesto.Reported.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.FigureA4.InitialManifesto.Reported.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.FigureA4.InitialManifesto.Reported.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)


#Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.FigureA4.InitialManifesto.Reported")



####
#Initial Perceived Party Differences
for (imp in 1:5) {
load(paste("df.imputed.initialcompetition",imp))
df<-subset(df, first.election>=1964, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age", "female", "eduni", "married",
			"roccupation.manual", "house.manual",
			"Urban", "rreligion" , "church.attendance",
			"unionm", "voted.past",
			"initial.partydf",
		"vote", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age, df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$union, df$voted.past, df$initial.partydf
)

y<-df$vote


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party DIF", "New.cohort*Party DIF",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past", "Initial.Perceived.PartyDIF"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.FigureA4.InitialPartyDIF.Reported.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.FigureA4.InitialPartyDIF.Reported.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.FigureA4.InitialPartyDIF.Reported.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.FigureA4.InitialPartyDIF.Reported.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.FigureA4.InitialPartyDIF.Reported.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.FigureA4.InitialPartyDIF.Reported.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

#Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.FigureA4.InitialPartyDIF.Reported")

###

#Initial Poll Margin
for (imp in 1:5) {
load(paste("df.imputed.initialcompetition",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age", "female", "eduni", "married",
			"roccupation.manual", "house.manual",
			"Urban", "rreligion" , "church.attendance",
			"unionm", "voted.past",
			"initial.poll.margin",
		"vote", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age, df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$union, df$voted.past, df$initial.poll.margin
)

y<-df$vote


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party DIF", "New.cohort*Party DIF",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past", "Initial.Poll.Margin"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.FigureA4.InitialPoll.Reported.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.FigureA4.InitialPoll.Reported.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.FigureA4.InitialPoll.Reported.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.FigureA4.InitialPoll.Reported.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.FigureA4.InitialPoll.Reported.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.FigureA4.InitialPoll.Reported.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.FigureA4.InitialPoll.Reported")




###

####
#### VALIDATED VOTE
#Initial constituency margin
for (imp in 1:5) {
load(paste("df.imputed.initialcompetition",imp))
df<-subset(df, nomove==1, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age", "female", "eduni", "married",
			"roccupation.manual", "house.manual",
			"Urban", "rreligion" , "church.attendance",
			"unionm", "voted.past",
			"initial.constituency.margin",
		"valid", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age, df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$union, df$voted.past, df$initial.constituency.margin
)

y<-df$valid

#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party DIF", "New.cohort*Party DIF",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past", "Initial.Constituency.Vote.Margin"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.FigureA4.InitialConstituency.Validated.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.FigureA4.InitialConstituency.Validated.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.FigureA4.InitialConstituency.Validated.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.FigureA4.InitialConstituency.Validated.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.FigureA4.InitialConstituency.Validated.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.FigureA4.InitialConstituency.Validated.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.FigureA4.InitialConstituency.Validated")

######

##
#Initial Manifesto Differences
for (imp in 1:5) {
load(paste("df.imputed.initialcompetition",imp))
df<-subset(df, first.election>=1945, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"logrile",
		"young.initiation",
		"fem.franchise", 
		"log.age", "female", "eduni", "married",
			"roccupation.manual", "house.manual",
			"Urban", "rreligion" , "church.attendance",
			"unionm", "voted.past",
			"initial.logrile",
		"valid", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$logrile,	I(df$logrile*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age, df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$union, df$voted.past, df$initial.logrile
)

y<-df$valid

#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Manifesto Differences", "New.cohort*Manifesto",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past", "Initial.Manifesto.Differences"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.FigureA4.InitialManifesto.Validated.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.FigureA4.InitialManifesto.Validated.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.FigureA4.InitialManifesto.Validated.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.FigureA4.InitialManifesto.Validated.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.FigureA4.InitialManifesto.Validated.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.FigureA4.InitialManifesto.Validated.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.FigureA4.InitialManifesto.Validated")


###
#Initial Perceived Party Differences
for (imp in 1:5) {
load(paste("df.imputed.initialcompetition",imp))
df<-subset(df, first.election>=1964, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age", "female", "eduni", "married",
			"roccupation.manual", "house.manual",
			"Urban", "rreligion" , "church.attendance",
			"unionm", "voted.past",
			"initial.partydf",
		"valid", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age, df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$union, df$voted.past, df$initial.partydf
)

y<-df$valid


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party DIF", "New.cohort*Party DIF",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past", "Initial.Perceived.PartyDIF"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.FigureA4.InitialPartyDIF.Validated.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.FigureA4.InitialPartyDIF.Validated.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.FigureA4.InitialPartyDIF.Validated.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.FigureA4.InitialPartyDIF.Validated.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.FigureA4.InitialPartyDIF.Validated.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.FigureA4.InitialPartyDIF.Validated.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

#Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.FigureA4.PartyDIF.Validated")

########

#Initial Poll Margin
for (imp in 1:5) {
load(paste("df.imputed.initialcompetition",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age", "female", "eduni", "married",
			"roccupation.manual", "house.manual",
			"Urban", "rreligion" , "church.attendance",
			"unionm", "voted.past",
			"initial.poll.margin",
		"vote", "electn", "constit"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age, df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$union, df$voted.past, df$initial.poll.margin
)

y<-df$vote


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)


#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 precb.election<-1	
 precb.area<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party DIF", "New.cohort*Party DIF",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past", "Initial.Poll.Margin"
			)

 B.election<-matrix(0,lastit,N.election)
  colnames(B.election)<-sort(unique(df$electn))
  B.area<-matrix(0,lastit,N.area)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			B.area=B.area, B.election=B.election,
			vars=colnames(Beta))
save(Results, file=paste("Results.FigureA4.InitialPoll.Validated.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.FigureA4.InitialPoll.Validated.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.FigureA4.InitialPoll.Validated.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.FigureA4.InitialPoll.Validated.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.FigureA4.InitialPoll.Validated.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.FigureA4.InitialPoll.Validated.MCMC.Imputed 5")
R.5<-Results$Beta

Beta<-rbind(R.1,R.2,R.3,R.4,R.5)

#Display results
apply(Beta,2,mean)
HPDinterval(as.mcmc(Beta), p=0.9)

save(Beta, file="Fixed-effects MCMC estimates.FigureA4.InitialPoll.Validated")

rm(list=ls())

#### Pool them all together for Figure A.4
load("Fixed-effects MCMC estimates.FigureA4.InitialConstituency.Reported")
Data.FigureA4.MCMC<-c("Initial Constituency Vote Margin", "Self-reported vote",
mean(Beta[,ncol(Beta)]), HPDinterval(as.mcmc(Beta[,ncol(Beta)]), p=0.9))

load("Fixed-effects MCMC estimates.FigureA4.InitialManifesto.Reported")
Data.FigureA4.MCMC<-rbind(Data.FigureA4.MCMC,
	c("Initial Right-Left Manifesto Differences", "Self-reported vote",
	mean(Beta[,ncol(Beta)]), HPDinterval(as.mcmc(Beta[,ncol(Beta)]), p=0.9)))

load("Fixed-effects MCMC estimates.FigureA4.InitialPartyDIF.Reported")
Data.FigureA4.MCMC<-rbind(Data.FigureA4.MCMC,
	c("Initial Perceived Party Differences", "Self-reported vote",
	mean(Beta[,ncol(Beta)]), HPDinterval(as.mcmc(Beta[,ncol(Beta)]), p=0.9)))

load("Fixed-effects MCMC estimates.FigureA4.InitialPoll.Reported")
Data.FigureA4.MCMC<-rbind(Data.FigureA4.MCMC,
	c("Initial Poll Margin", "Self-reported vote",
	mean(Beta[,ncol(Beta)]), HPDinterval(as.mcmc(Beta[,ncol(Beta)]), p=0.9)))

load("Fixed-effects MCMC estimates.FigureA4.InitialConstituency.Validated")
Data.FigureA4.MCMC<-rbind(Data.FigureA4.MCMC,
	c("Initial Constituency Vote Margin", "Validated vote",
	mean(Beta[,ncol(Beta)]), HPDinterval(as.mcmc(Beta[,ncol(Beta)]), p=0.9)))

load("Fixed-effects MCMC estimates.FigureA4.InitialManifesto.Validated")
Data.FigureA4.MCMC<-rbind(Data.FigureA4.MCMC,
	c("Initial Right-Left Manifesto Differences", "Validated vote",
	mean(Beta[,ncol(Beta)]), HPDinterval(as.mcmc(Beta[,ncol(Beta)]), p=0.9)))

load("Fixed-effects MCMC estimates.FigureA4.PartyDIF.Validated")
Data.FigureA4.MCMC<-rbind(Data.FigureA4.MCMC,
	c("Initial Perceived Party Differences", "Validated vote",
	mean(Beta[,ncol(Beta)]), HPDinterval(as.mcmc(Beta[,ncol(Beta)]), p=0.9)))

load("Fixed-effects MCMC estimates.FigureA4.InitialPoll.Validated")
Data.FigureA4.MCMC<-rbind(Data.FigureA4.MCMC,
	c("Initial Poll Margin", "Validated vote",
	mean(Beta[,ncol(Beta)]), HPDinterval(as.mcmc(Beta[,ncol(Beta)]), p=0.9)))
colnames(Data.FigureA4.MCMC)<-c("Variable", 
				"Vote", "Mean", "lower90", "upper90")
rownames(Data.FigureA4.MCMC)<-NULL
write.csv(Data.FigureA4.MCMC, file="Data.FigureA4.MCMC.csv")

rm(list=ls())

df<-read.csv("Data.FigureA4.MCMC.csv")

df$Variable<-factor(df$Variable, 
	levels=rev(c("Initial Poll Margin",
"Initial Constituency Vote Margin",
		"Initial Perceived Party Differences",
		"Initial Right-Left Manifesto Differences")))
	

p <- ggplot(df, aes(y= Variable, x=Mean))+
	geom_point(size=3) + geom_errorbarh(aes(xmax=upper90, xmin=lower90), height=0.1)+
	facet_wrap(~Vote)+ 
	xlab("")+
	ylab("")+geom_vline(xintercept = 0, linetype = "longdash")
p+theme_bw()+theme(strip.text=element_text(size=14))

rm(list=ls())

################################## TABLE A.3 #################################
######## First we use MCMC estimation 
####### Then we use likelihood-based estimation for robustness

#TABLE A.3 - Column 1 (MCMC)
load("completecase.validated.dutyandefficacy")
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban",  "unionm", "voted.past",
		"pstrong", "duty", "efficacy", "initial.seat.margin",
		"valid", "electn", "constit", "cohort.franklin"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))
Cohort<-as.numeric(factor(df$cohort.franklin), levels=unique(df$cohort.franklin))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		
N.cohort<-length(unique(Cohort))


Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1
Matrix.Cohort<-as.spam(matrix(0,n,N.cohort))
for (i in 1:N.cohort) Matrix.Cohort[Cohort==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, 
		df$unionm, df$voted.past, df$initial.seat.margin,
		df$pstrong, df$duty, df$efficacy
)

y<-df$valid


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)
n.cohort<-table(Cohort)

#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 b.cohort<-rep(0,N.cohort)
 precb.election<-1	
 precb.area<-1
precb.cohort<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party Dif", "New.cohort*Party Dif",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", 
			"Union", "Voted.past", "Initial.Seat.Margin",
			"PartyID", "Duty", "Efficacy"
		)

 B.election<-matrix(0,lastit,N.election)
  B.area<-matrix(0,lastit,N.area)
  B.cohort<-matrix(0,lastit,N.cohort)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)
  Sigma2.cohort<-rep(0,lastit)


###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]+b.cohort[Cohort]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]-b.cohort[Cohort]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election]-b.cohort[Cohort],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]-b.cohort[Cohort]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area]-b.cohort[Cohort],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area]-b.cohort[Cohort])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

#m.cohort<-tapply(z-X%*%beta-b.area[Area]-b.election[Election],Cohort,sum) # R 32
m.cohort<-as.vector(t(Matrix.Cohort)%*%(z-X%*%beta-b.area[Area]-b.election[Election])) # Requires R 64
b.cohort<-rnorm(N.cohort,(1/(precb.cohort+n.cohort))*m.cohort,sqrt(1/(precb.cohort+n.cohort)))
b.cohort<-b.cohort-mean(b.cohort)
precb.cohort<-rgamma(1,l0+N.cohort/2,d0+crossprod(b.cohort,b.cohort)/2)


   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
Sigma2.cohort[j]<-1/precb.cohort
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
 B.cohort[j,]<-c(b.cohort)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			Sigma2.cohort=Sigma2.cohort, 
			B.area=B.area, B.election=B.election, B.cohort=B.cohort,
			vars=colnames(Beta))
save(Results, file="Results.TableA3.Col1.MCMC")


# Display results
Beta<-Results$Beta
Estimates.TableA3.Col1.MCMC<-cbind(apply(Beta,2,mean), HPDinterval(as.mcmc(Beta), p=0.9))
colnames(Estimates.TableA3.Col1.MCMC)<-c("Estimate", "Lower90", "Upper90")

### Order the rows to make them appear as in Table A3, Col 1
Estimates.TableA3.Col1.MCMC<-Estimates.TableA3.Col1.MCMC[c(2:4,7:8,5:6,9:13,15,14, 16:25,1),]

# Display MCMC estimates
round(Estimates.TableA3.Col1.MCMC, digits=3)


save(Beta, file="Fixed-effects MCMC estimates.TableA3.Col1")
rm(list=ls())

# Compute DIC
load("Results.TableA3.Col1.MCMC")

load("completecase.validated.dutyandefficacy")
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban",  "unionm", "voted.past",
		"pstrong", "duty", "efficacy", "initial.seat.margin",
		"valid", "electn", "constit", "cohort.franklin"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))
Cohort<-as.numeric(factor(df$cohort.franklin), levels=unique(df$cohort.franklin))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, 
		df$unionm, df$voted.past, df$initial.seat.margin,
		df$pstrong, df$duty, df$efficacy
)

y<-df$valid


D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area]+Results$B.cohort[s,Cohort], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area]+Results$B.cohort[s,Cohort])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]+
	apply(Results$B.cohort,2,mean)[Cohort], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]+
	apply(Results$B.cohort,2,mean)[Cohort]))
)




DIC<- -2*mean(D)+(-2*mean(D)-D.bar)
DIC

rm(list=ls())


#TABLE A.3 - Column 2 (MCMC)
load("completecase.reported.dutyandefficacy")
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "unionm", "voted.past",
		"pstrong", "duty", "efficacy", "initial.seat.margin",
		"vote", "electn", "constit", "cohort.franklin"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))
Cohort<-as.numeric(factor(df$cohort.franklin), levels=unique(df$cohort.franklin))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		
N.cohort<-length(unique(Cohort))


Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1
Matrix.Cohort<-as.spam(matrix(0,n,N.cohort))
for (i in 1:N.cohort) Matrix.Cohort[Cohort==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, 
		df$unionm, df$voted.past, df$initial.seat.margin,
		df$pstrong, df$duty, df$efficacy
)

y<-df$vote


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)
n.cohort<-table(Cohort)

#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 b.cohort<-rep(0,N.cohort)
 precb.election<-1	
 precb.area<-1
precb.cohort<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party Dif", "New.cohort*Party Dif",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", 
			"Union", "Voted.past", "Initial.Seat.Margin",
			"PartyID", "Duty", "Efficacy"
		)

 B.election<-matrix(0,lastit,N.election)
  B.area<-matrix(0,lastit,N.area)
  B.cohort<-matrix(0,lastit,N.cohort)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)
  Sigma2.cohort<-rep(0,lastit)


###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]+b.cohort[Cohort]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]-b.cohort[Cohort]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election]-b.cohort[Cohort],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]-b.cohort[Cohort]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area]-b.cohort[Cohort],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area]-b.cohort[Cohort])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

#m.cohort<-tapply(z-X%*%beta-b.area[Area]-b.election[Election],Cohort,sum) # R 32
m.cohort<-as.vector(t(Matrix.Cohort)%*%(z-X%*%beta-b.area[Area]-b.election[Election])) # Requires R 64
b.cohort<-rnorm(N.cohort,(1/(precb.cohort+n.cohort))*m.cohort,sqrt(1/(precb.cohort+n.cohort)))
b.cohort<-b.cohort-mean(b.cohort)
precb.cohort<-rgamma(1,l0+N.cohort/2,d0+crossprod(b.cohort,b.cohort)/2)


   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
Sigma2.cohort[j]<-1/precb.cohort
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
 B.cohort[j,]<-c(b.cohort)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			Sigma2.cohort=Sigma2.cohort, 
			B.area=B.area, B.election=B.election, B.cohort=B.cohort,
			vars=colnames(Beta))
save(Results, file="Results.TableA3.Col2.MCMC")

# Display results

Beta<-Results$Beta
Estimates.TableA3.Col2.MCMC<-cbind(apply(Beta,2,mean), HPDinterval(as.mcmc(Beta), p=0.9))
colnames(Estimates.TableA3.Col2.MCMC)<-c("Estimate", "Lower90", "Upper90")

### Order the rows to make them appear as in Table A3, Col 2
Estimates.TableA3.Col2.MCMC<-Estimates.TableA3.Col2.MCMC[c(2:4,7:8,5:6,9:13,15,14, 16:25,1),]

# Display MCMC estimates
round(Estimates.TableA3.Col2.MCMC, digits=3)

save(Beta, file="Fixed-effects MCMC estimates.TableA3.Col2")
rm(list=ls())

# Compute DIC
load("Results.TableA3.Col2.MCMC")
load("completecase.reported.dutyandefficacy")
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "unionm", "voted.past",
		"pstrong", "duty", "efficacy", "initial.seat.margin",
		"vote", "electn", "constit", "cohort.franklin"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))
Cohort<-as.numeric(factor(df$cohort.franklin), levels=unique(df$cohort.franklin))

X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, 
		df$unionm, df$voted.past, df$initial.seat.margin,
		df$pstrong, df$duty, df$efficacy
)

y<-df$vote



D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area]+Results$B.cohort[s,Cohort], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area]+Results$B.cohort[s,Cohort])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]+
	apply(Results$B.cohort,2,mean)[Cohort], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]+
	apply(Results$B.cohort,2,mean)[Cohort]))
)


DIC<- -2*mean(D)+(-2*mean(D)-D.bar)
DIC

rm(list=ls())

###
#TABLE A.3 - Column 3 (MCMC)
for (imp in 1:5) {

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"pstrong", "duty", "efficacy", "initial.seat.margin",
		"vote", "electn", "constit", "cohort.franklin"))
df<-na.omit(df)


Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))
Cohort<-as.numeric(factor(df$cohort.franklin), levels=unique(df$cohort.franklin))


# Set up data
n<-nrow(df)				
N.election<-length(unique(Election))  
N.area<-length(unique(Area))		
N.cohort<-length(unique(Cohort))

Matrix.Election<-as.spam(matrix(0,n,N.election))
for (i in 1:N.election) Matrix.Election[Election==i,i]<-1
Matrix.Area<-as.spam(matrix(0,n,N.area))
for (i in 1:N.area) Matrix.Area[Area==i,i]<-1
Matrix.Cohort<-as.spam(matrix(0,n,N.cohort))
for (i in 1:N.cohort) Matrix.Cohort[Cohort==i,i]<-1


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past, df$initial.seat.margin,
		df$pstrong, df$duty, df$efficacy
)

y<-df$vote


#### Data params
k<-ncol(X)
n.area<-table(Area)
n.election<-table(Election)
n.cohort<-table(Cohort)

#### Priors 
 mbeta0<-rep(0,k)				# Prior Mean for Beta
 vbeta0<-diag(10,k)			# Prior Cov of Beta (vague)
 prec0<-solve(vbeta0)			# Prec beta
 vbeta<-solve(prec0+crossprod(X,X))	# Posterior variance beta
 l0<-d0<-.01					# Hyperparameters for precb

#Initial Values
 beta<-rep(0,k)
 b.election<-rep(0,N.election)
 b.area<-rep(0,N.area)
 b.cohort<-rep(0,N.cohort)
 precb.election<-1	
 precb.area<-1
precb.cohort<-1	
 z<-rep(0,n)				# Latent Normal Variable

# MCMC Info #
#############
 nsim<-350000  # MCMC Iterations
 thin<-50         	# Thinning Interval 
 burn<-nsim/2   		 # Burn-in
 lastit<-(nsim-burn)/thin	# Last stored value

#########
# Store #
#########
  Beta<-matrix(0,lastit,k)
 colnames(Beta)<-c("Intercept", "New cohort",
			"Lag.seatmg", "New.cohort*Lag.seatmg", 
			"Last.polls", "New.cohort*Last.polls",
			"Lag.constit", "New.cohort*Last.constit",
			"Perceived Party Dif", "New.cohort*Party Dif",
			"Young Initiation", "Fem. Franchising",
			"Log.Age", "Female", "Education", 
			"Married", "Roccupation", "House.Manual",
			"Urban", "Religion", "Church.Attendance", 
			"Union", "Voted.past", "Initial.Seat.Margin",
			"PartyID", "Duty", "Efficacy"
		)

 B.election<-matrix(0,lastit,N.election)
  B.area<-matrix(0,lastit,N.area)
  B.cohort<-matrix(0,lastit,N.cohort)
  Sigma2.area<-rep(0,lastit)
  Sigma2.election<-rep(0,lastit)
  Sigma2.cohort<-rep(0,lastit)

###################
# GIBBS SAMPLER	#
###################

for (i in 1:nsim) {
  muz<-X%*%beta+b.election[Election]+b.area[Area]+b.cohort[Cohort]			
  z[y==0]<-qnorm(runif(n,0,pnorm(0,muz,1)),muz,1)[y==0]
  z[y==1]<-qnorm(runif(n,pnorm(0,muz,1),1),muz,1)[y==1]
   mbeta <- vbeta%*%(prec0%*%mbeta0+crossprod(X,z-b.election[Election]-b.area[Area]-b.cohort[Cohort]))
   beta<-c(rmvnorm(1,mbeta,vbeta))
 
#m.area<-tapply(z-X%*%beta-b.election[Election]-b.cohort[Cohort],Area,sum)  # R 32
m.area<-as.vector(t(Matrix.Area)%*%(z-X%*%beta-b.election[Election]-b.cohort[Cohort]))  # Requires R 64
b.area<-rnorm(N.area,(1/(precb.area+n.area))*m.area,sqrt(1/(precb.area+n.area)))
b.area<-b.area-mean(b.area)
precb.area<-rgamma(1,l0+N.area/2,d0+crossprod(b.area,b.area)/2)

#m.election<-tapply(z-X%*%beta-b.area[Area]-b.cohort[Cohort],Election,sum)	# R 32
m.election<-as.vector(t(Matrix.Election)%*%(z-X%*%beta-b.area[Area]-b.cohort[Cohort])) # Requires R 64
b.election<-rnorm(N.election,(1/(precb.election+n.election))*m.election,sqrt(1/(precb.election+n.election)))
b.election<-b.election-mean(b.election)
precb.election<-rgamma(1,l0+N.election/2,d0+crossprod(b.election,b.election)/2)

#m.cohort<-tapply(z-X%*%beta-b.area[Area]-b.election[Election],Cohort,sum) # R 32
m.cohort<-as.vector(t(Matrix.Cohort)%*%(z-X%*%beta-b.area[Area]-b.election[Election])) # Requires R 64
b.cohort<-rnorm(N.cohort,(1/(precb.cohort+n.cohort))*m.cohort,sqrt(1/(precb.cohort+n.cohort)))
b.cohort<-b.cohort-mean(b.cohort)
precb.cohort<-rgamma(1,l0+N.cohort/2,d0+crossprod(b.cohort,b.cohort)/2)


   if (i> burn & i%%thin==0) {
    j<-(i-burn)/thin
 Beta[j,]<-beta
 Sigma2.area[j]<-1/precb.area
 Sigma2.election[j]<-1/precb.election
Sigma2.cohort[j]<-1/precb.cohort
 B.area[j,]<-c(b.area)
 B.election[j,]<-c(b.election)
 B.cohort[j,]<-c(b.cohort)
}
  if (i%%1000==0) print(i)
 }


Results<-list(Beta=Beta, Sigma2.area=Sigma2.area, 
			Sigma2.election=Sigma2.election, 
			Sigma2.cohort=Sigma2.cohort, 
			B.area=B.area, B.election=B.election, B.cohort=B.cohort,
			vars=colnames(Beta))
save(Results, file=paste("Results.TableA3.Col3.MCMC.Imputed", imp))

print(imp)
rm(list=ls()) 
}

load("Results.TableA3.Col3.MCMC.Imputed 1")
R.1<-Results$Beta
load("Results.TableA3.Col3.MCMC.Imputed 2")
R.2<-Results$Beta
load("Results.TableA3.Col3.MCMC.Imputed 3")
R.3<-Results$Beta
load("Results.TableA3.Col3.MCMC.Imputed 4")
R.4<-Results$Beta
load("Results.TableA3.Col3.MCMC.Imputed 5")
R.5<-Results$Beta

Results<-rbind(R.1,R.2,R.3,R.4,R.5)

# Display results
Estimates.TableA3.Col3.MCMC<-cbind(apply(Results,2,mean), HPDinterval(as.mcmc(Results), p=0.9))
colnames(Estimates.TableA3.Col3.MCMC)<-c("Estimate", "Lower90", "Upper90")

### Order the rows to make them appear as in Table A3, Col 3
Estimates.TableA3.Col3.MCMC<-Estimates.TableA3.Col3.MCMC[c(2:4,7:8,5:6,9:13,15,14, 16:27,1),]

# Display MCMC estimates
round(Estimates.TableA3.Col3.MCMC, digits=3)

save(Results, file="Fixed-effects MCMC estimates.TableA3.Col3")

rm(list=ls())

# Compute DIC
DIC<-c()

for (imp in 1:5) {
load(paste("Results.TableA3.Col3.MCMC.Imputed", imp))

load(paste("df.imputed",imp))
df<-subset(df, select=c("new.cohort",
		"lag_seatmg",
		"last_polls", 
		"lag_constit",
		"partydf",
		"young.initiation",
		"fem.franchise", 
		"log.age",
		"female", "eduni", "married","roccupation.manual", "house.manual",
		"Urban", "rreligion", "church.attendance", "unionm", "voted.past",
		"pstrong", "duty", "efficacy", "initial.seat.margin",
		"vote", "electn", "constit", "cohort.franklin"))
df<-na.omit(df)

Election<-as.numeric(factor(df$electn), levels=unique(df$electn))
Area<-as.numeric(factor(df$constit), levels=unique(df$constit))
Cohort<-as.numeric(factor(df$cohort.franklin), levels=unique(df$cohort.franklin))


X<-cbind(1, df$new.cohort,
		df$lag_seatmg, I(df$lag_seatmg*df$new.cohort),
		df$last_polls, I(df$last_polls*df$new.cohort),
		df$lag_constit, I(df$lag_constit*df$new.cohort),
		df$partydf,	I(df$partydf*df$new.cohort), 
		df$young.initiation,
		df$fem.franchise, 
		df$log.age,
		df$female, df$eduni, df$married,
		df$roccupation.manual, df$house.manual,
		df$Urban, df$rreligion, df$church.attendance,
		df$unionm, df$voted.past, df$initial.seat.margin,
		df$pstrong, df$duty, df$efficacy
)

y<-df$vote



D<-sapply(1:dim(Results$Beta)[1], function(s) 
sum(y*pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area]+Results$B.cohort[s,Cohort], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%Results$Beta[s,]+Results$B.election[s,Election]+
	Results$B.area[s,Area]+Results$B.cohort[s,Cohort])))
)


D.bar<-sum(y*pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]+apply(Results$B.cohort,2,mean)[Cohort], log.p=TRUE)+(1-y)*
log(1-pnorm(X%*%apply(Results$Beta,2,mean)+apply(Results$B.election,2,mean)[Election]+
	apply(Results$B.area,2,mean)[Area]+apply(Results$B.cohort,2,mean)[Cohort]))
)


DIC<- c(DIC,-2*mean(D)+(-2*mean(D)-D.bar))

print(imp)
}

mean(DIC)


############## Now repeat estimation using likelihood-based methods ##########

# Table A.3 - Column 1 (Likelihood-based)
load("completecase.validated.dutyandefficacy")
result<-glmer(valid~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+
			unionm+voted.past+
			initial.seat.margin+
			pstrong+duty+efficacy+
			(1|constit)+(1|electn)+(1|cohort.franklin),
				data=df, family = binomial("probit")) 

summary(result)

Results.TableA3.Col1.ML<-cbind(fixef(result), sqrt(diag(vcov(result))),
cbind(fixef(result)-1.645*sqrt(diag(vcov(result))),
	fixef(result)+1.645*sqrt(diag(vcov(result))),
cbind(fixef(result)-1.945*sqrt(diag(vcov(result))),
	fixef(result)+1.945*sqrt(diag(vcov(result))),
cbind(fixef(result)-2.58*sqrt(diag(vcov(result))),
	fixef(result)+2.58*sqrt(diag(vcov(result)))))))

colnames(Results.TableA3.Col1.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display "results" 
Results.TableA3.Col1.ML

# Display significance "stars"
Result<-Results.TableA3.Col1.ML

Significance.TableA3.Col1.ML<-as.matrix(
c(ifelse(rowSums(sign(Result[,7:8]))!=0,"***",
ifelse(rowSums(sign(Result[,5:6]))!=0,"**",
ifelse(rowSums(sign(Result[,3:4]))!=0,"*"," ")))))
colnames(Significance.TableA3.Col1.ML)<-c("Asterisks")

### Order the rows to make them appear as in Table A3, Col 1
Significance.TableA3.Col1.ML<-as.matrix(Significance.TableA3.Col1.ML[c(2:4,7:8,5:6,9:13,15,14, 16:25,1),])

Significance.TableA3.Col1.ML

rm(list=ls())


# Table A.3 - Column 2 (Likelihood-based)
load("completecase.reported.dutyandefficacy")
result<-glmer(vote~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+
			unionm+voted.past+
			initial.seat.margin+
			pstrong+duty+efficacy+
			(1|constit)+(1|electn)+(1|cohort.franklin),
				data=df, family = binomial("probit")) 

summary(result)


Results.TableA3.Col2.ML<-cbind(fixef(result), sqrt(diag(vcov(result))),
cbind(fixef(result)-1.645*sqrt(diag(vcov(result))),
	fixef(result)+1.645*sqrt(diag(vcov(result))),
cbind(fixef(result)-1.945*sqrt(diag(vcov(result))),
	fixef(result)+1.945*sqrt(diag(vcov(result))),
cbind(fixef(result)-2.58*sqrt(diag(vcov(result))),
	fixef(result)+2.58*sqrt(diag(vcov(result)))))))

colnames(Results.TableA3.Col2.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")


# Display "results" 
Results.TableA3.Col2.ML

# Display significance "stars"
Result<-Results.TableA3.Col2.ML

Significance.TableA3.Col2.ML<-as.matrix(
c(ifelse(rowSums(sign(Result[,7:8]))!=0,"***",
ifelse(rowSums(sign(Result[,5:6]))!=0,"**",
ifelse(rowSums(sign(Result[,3:4]))!=0,"*"," ")))))
colnames(Significance.TableA3.Col2.ML)<-c("Asterisks")

### Order the rows to make them appear as in Table A3, Col 2
Significance.TableA3.Col2.ML<-as.matrix(Significance.TableA3.Col2.ML[c(2:4,7:8,5:6,9:13,15,14, 16:25,1),])

# Display "stars"
Significance.TableA3.Col2.ML

rm(list=ls())


# Table A.3 - Column 3 (Likelihood-based)
Result<-list()
for (j in 1:5) { 
load(paste("df.imputed",j))

result<-glmer(vote~new.cohort+
			lag_seatmg+I(new.cohort*lag_seatmg)+
			last_polls+I(new.cohort*last_polls)+
			lag_constit+I(new.cohort*lag_constit)+
			partydf+I(new.cohort*partydf)+
			young.initiation+fem.franchise+
			log.age+female+eduni+married+
			roccupation.manual+house.manual+
			Urban+rreligion+church.attendance+
			unionm+voted.past+
			initial.seat.margin+
			pstrong+duty+efficacy+
			(1|constit)+(1|electn)+(1|cohort.franklin),
				data=df, family = binomial("probit")) 

Result[[j]]<-result

print(j)
}

## Rubin (1987)'s pooling methodology 
Pooled.means<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Pooled.means<-Pooled.means+as.matrix(fixef(Result[[j]]))
}

Pooled.means<-Pooled.means/5


Var.within<-matrix(0, nrow=length(fixef(Result[[j]])))

for (j in 1:5) {
Var.within<-Var.within+diag(vcov(Result[[j]]))
}
Var.within<-Var.within/5

Var.between<-matrix(0, nrow=length(fixef(Result[[j]])))
for (j in 1:5) {
Var.between<- Var.between+((fixef(Result[[j]])- Pooled.means)^2)/4
}

Var.between<-Var.between*(1+1/5)
Var.total<-Var.within+Var.between

Results.TableA3.Col3.ML<-cbind(Pooled.means, sqrt(Var.total),
cbind(Pooled.means-1.645*sqrt(Var.total),
	Pooled.means+1.645*sqrt(Var.total)),
cbind(Pooled.means-1.945*sqrt(Var.total),
	Pooled.means+1.945*sqrt(Var.total)),
cbind(Pooled.means-2.58*sqrt(Var.total),
	Pooled.means+2.58*sqrt(Var.total)))

colnames(Results.TableA3.Col3.ML)<-c("Mean", "Std.Error", "lower90", "upper90",
"lower95", "upper95", "lower99", "upper99")

# Display results
Results.TableA3.Col3.ML

# Display significance "stars"
Result<-Results.TableA3.Col3.ML

Significance.TableA3.Col3.ML<-as.matrix(
c(ifelse(rowSums(sign(Result[,7:8]))!=0,"***",
ifelse(rowSums(sign(Result[,5:6]))!=0,"**",
ifelse(rowSums(sign(Result[,3:4]))!=0,"*"," ")))))
colnames(Significance.TableA3.Col3.ML)<-c("Asterisks")

### Order the rows to make them appear as in Table A3, Col 3
Significance.TableA3.Col3.ML<-as.matrix(Significance.TableA3.Col3.ML[c(2:4,7:8,5:6,9:13,15,14, 16:27,1),])

Significance.TableA3.Col3.ML

write.csv(Results.TableA3.Col3.ML, file="Results.TableA3.Col3.ML.csv")
rm(list=ls())













